diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 78bad0e36dd..6fe976f06b9 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -66,12 +66,13 @@ jobs: exe-suffix: ".exe" dune-profile: release + # Disable for now. eio and eio_main require ocaml >= 5.2.0 # Verify that the compiler still builds with the oldest OCaml version we support. - - os: ubuntu-24.04 - ocaml_compiler: ocaml-variants.5.0.0+options,ocaml-option-static - node-target: linux-x64 - rust-target: x86_64-unknown-linux-musl - dune-profile: static + # - os: ubuntu-24.04 + # ocaml_compiler: ocaml-variants.5.0.0+options,ocaml-option-static + # node-target: linux-x64 + # rust-target: x86_64-unknown-linux-musl + # dune-profile: static runs-on: ${{matrix.os}} @@ -107,7 +108,7 @@ jobs: # https://github.com/ocaml/setup-ocaml/blob/2f57267f071bc8547dfcb9433ff21d44fffef190/packages/setup-ocaml/src/unix.ts#L48 # plus OPAM wants cmake packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync cmake - version: v4 + version: v5 - name: Restore rewatch build cache id: rewatch-build-cache @@ -176,6 +177,56 @@ jobs: C:\.opam key: ${{ env.opam_cache_key }} + # The static OCaml switch uses musl-gcc. linux-libc-dev installs Linux + # headers under /usr/include, but musl-gcc searches the musl include dir. + # Link the Linux headers into musl's include path so packages with C stubs + # such as uring can include headers. + - name: Make Linux headers visible to musl-gcc + if: runner.os == 'Linux' + run: | + set -eux + + # Get the GNU multiarch triplet for the current machine. + # Examples: + # x86_64-linux-gnu + # aarch64-linux-gnu + GNU_MULTIARCH="$(gcc -print-multiarch)" + + # Convert the GNU triplet into the musl include directory name. + # Examples: + # x86_64-linux-gnu -> x86_64-linux-musl + # aarch64-linux-gnu -> aarch64-linux-musl + MUSL_MULTIARCH="${GNU_MULTIARCH%-gnu}-musl" + + # musl-gcc searches this include directory. + MUSL_INCLUDE="/usr/include/${MUSL_MULTIARCH}" + + # Linux arch-specific asm headers are installed here by linux-libc-dev. + GNU_ASM="/usr/include/${GNU_MULTIARCH}/asm" + + # Ensure the musl include directory exists. + sudo mkdir -p "$MUSL_INCLUDE" + + # Remove old paths first. + # This avoids silently keeping broken/stale symlinks from previous runs. + sudo rm -rf "$MUSL_INCLUDE/linux" + sudo rm -rf "$MUSL_INCLUDE/asm" + sudo rm -rf "$MUSL_INCLUDE/asm-generic" + + # Expose Linux UAPI headers to musl-gcc. + # This fixes packages that include headers like . + sudo ln -s /usr/include/linux "$MUSL_INCLUDE/linux" + + # Expose architecture-specific asm headers to musl-gcc. + sudo ln -s "$GNU_ASM" "$MUSL_INCLUDE/asm" + + # Expose generic asm headers used by many Linux headers. + sudo ln -s /usr/include/asm-generic "$MUSL_INCLUDE/asm-generic" + + # Smoke test: fail early if musl-gcc still cannot find Linux headers. + echo '#include ' > /tmp/test.c + musl-gcc -c /tmp/test.c -o /tmp/test.o + - name: Use OCaml ${{matrix.ocaml_compiler}} uses: ocaml/setup-ocaml@v3.6.0 if: steps.cache-opam-env.outputs.cache-hit != 'true' @@ -326,6 +377,11 @@ jobs: if: runner.os != 'Windows' run: make -C tests/gentype_tests/typescript-react-example clean test + # The Makefile skip some tests on Windows because OCaml Eio process operations is not supported on Windows yet + # Eio.Stdenv.process_mgr raise a error, see https://github.com/ocaml-multicore/eio/blob/37d6e67f7e25b43e4a66574ed98838c79f1a21b4/lib_eio_windows/eio_windows.ml#L36 + - name: Run LSP tests + run: opam exec -- make test-lsp + # On Windows, after running setup-ocaml (if it wasn't cached yet or the cache couldn't be restored), # Cygwin bash is used instead of Git Bash for Windows, breaking the rewatch tests. # So we need to adjust the path to bring back Git Bash for Windows. @@ -604,7 +660,7 @@ jobs: uses: actions/checkout@v6 - name: Run make in dev container uses: devcontainers/ci@v0.3 - with: + with: push: never runCmd: make diff --git a/Makefile b/Makefile index 9b096b7c00e..801e1457961 100644 --- a/Makefile +++ b/Makefile @@ -176,7 +176,25 @@ test-gentype: lib test-rewatch: lib ./rewatch/tests/suite.sh $(RESCRIPT_EXE) -test-all: test test-gentype test-analysis test-tools test-rewatch +test-lsp: lib + @for dir in tests/lsp_tests/*-workspace/; do \ + [ -d "$$dir" ] || continue; \ + echo "Building $${dir%/}..."; \ + ( cd "$$dir" && yarn clean && yarn build ); \ + done + @dune runtest + @if [ "$$OS" = "Windows_NT" ]; then \ + echo "Skipping lsp-tests executable on Windows"; \ + else \ + dune exec -- lsp-tests; \ + fi + @if [ -n "$$(git ls-files --modified tests/lsp_tests/**/*.expected)" ]; then \ + echo "The lsp_tests snapshot doesn't match. Double check that the output is correct, run 'make test-lsp' and stage the diff"; \ + git --no-pager diff tests/lsp_tests/**/*.expected; \ + exit 1; \ + fi \ + +test-all: test test-gentype test-analysis test-tools test-rewatch test-lsp # Playground diff --git a/analysis/src/codemod.ml b/analysis/src/codemod.ml index 9b0812dd9a7..ce16e2f2592 100644 --- a/analysis/src/codemod.ml +++ b/analysis/src/codemod.ml @@ -5,43 +5,57 @@ let rec collect_patterns p = | Ppat_or (p1, p2) -> collect_patterns p1 @ [p2] | _ -> [p] -let transform ~source ~pos ~debug ~typ ~hint = - let structure, print_expr, _, _ = Xform.parse_implementation ~source in - match typ with - | AddMissingCases -> ( - let source = "let " ^ hint ^ " = ()" in - let {Res_driver.parsetree = hint_structure} = - Res_driver.parse_implementation_from_source ~for_printer:false - ~display_filename:"" ~source - in - match hint_structure with - | [{pstr_desc = Pstr_value (_, [{pvb_pat = pattern}])}] -> ( - let cases = - collect_patterns pattern - |> List.map (fun (p : Parsetree.pattern) -> - Ast_helper.Exp.case p (Type_utils.Codegen.mk_fail_with_exp ())) +let transform_opt ~source ~pos ~debug ~typ ~hint = + let log message = if debug then print_endline message in + try + let structure, print_expr, _, _ = Xform.parse_implementation ~source in + match typ with + | AddMissingCases -> ( + let source = "let " ^ hint ^ " = ()" in + let {Res_driver.parsetree = hint_structure} = + Res_driver.parse_implementation_from_source ~for_printer:false + ~display_filename:"" ~source in - let result = ref None in - let mk_iterator ~pos ~result = - let expr (iterator : Ast_iterator.iterator) (exp : Parsetree.expression) - = - match exp.pexp_desc with - | Pexp_match (e, existing_cases) - when Pos.of_lexing exp.pexp_loc.loc_start = pos -> - result := - Some {exp with pexp_desc = Pexp_match (e, existing_cases @ cases)} - | _ -> Ast_iterator.default_iterator.expr iterator exp + match hint_structure with + | [{pstr_desc = Pstr_value (_, [{pvb_pat = pattern}])}] -> ( + let cases = + collect_patterns pattern + |> List.map (fun (p : Parsetree.pattern) -> + Ast_helper.Exp.case p (Type_utils.Codegen.mk_fail_with_exp ())) in - {Ast_iterator.default_iterator with expr} - in - let iterator = mk_iterator ~pos ~result in - iterator.structure iterator structure; - match !result with - | None -> - if debug then print_endline "Found no result"; - exit 1 - | Some switch_expr -> - print_expr ~range:(Loc.range_of_loc switch_expr.pexp_loc) switch_expr) - | _ -> - if debug then print_endline "Mismatch in expected structure"; - exit 1) + let result = ref None in + let mk_iterator ~pos ~result = + let expr (iterator : Ast_iterator.iterator) + (exp : Parsetree.expression) = + match exp.pexp_desc with + | Pexp_match (e, existing_cases) + when Pos.of_lexing exp.pexp_loc.loc_start = pos -> + result := + Some + {exp with pexp_desc = Pexp_match (e, existing_cases @ cases)} + | _ -> Ast_iterator.default_iterator.expr iterator exp + in + {Ast_iterator.default_iterator with expr} + in + let iterator = mk_iterator ~pos ~result in + iterator.structure iterator structure; + match !result with + | None -> + log "Found no result"; + None + | Some switch_expr -> + Some + (print_expr + ~range:(Loc.range_of_loc switch_expr.pexp_loc) + switch_expr)) + | _ -> + log "Mismatch in expected structure"; + None) + with exn -> + log ("Codemod failed: " ^ Printexc.to_string exn); + None + +let transform ~source ~pos ~debug ~typ ~hint = + match transform_opt ~source ~pos ~debug ~typ ~hint with + | Some result -> result + | None -> exit 1 diff --git a/analysis/src/packages.ml b/analysis/src/packages.ml index 3c6d6d530d2..fd313e9acd1 100644 --- a/analysis/src/packages.ml +++ b/analysis/src/packages.ml @@ -172,12 +172,23 @@ let new_bs_package ~root_path = |> List.rev_append opens_from_compiler_flags |> List.map (fun path -> path @ ["place holder"]) in + let dependencies = + match config |> Yojson_helpers.get "dependencies" with + | Some (`List deps) -> + deps + |> List.filter_map (fun (x : Yojson.Safe.t) -> + match x with + | `String name -> Some name + | _ -> None) + | _ -> [] + in { generic_jsx_module; suffix; rescript_version; root_path; project_files; + dependencies; dependencies_files; paths_for_module; opens; diff --git a/analysis/src/shared_types.ml b/analysis/src/shared_types.ml index 173a6bfb7a7..9f1a8aa8220 100644 --- a/analysis/src/shared_types.ml +++ b/analysis/src/shared_types.ml @@ -530,6 +530,7 @@ and package = { suffix: string; root_path: file_path; project_files: File_set.t; + dependencies: string list; dependencies_files: File_set.t; paths_for_module: (file, paths) Hashtbl.t; namespace: string option; @@ -965,3 +966,106 @@ let extract_exp_apply_args ~args = | [] -> List.rev acc in args |> process_args ~acc:[] + +let state_to_yojson (state : state) = + let option_to_yojson f = function + | None -> `Null + | Some value -> f value + in + + let string_set_to_yojson set = + `List (set |> File_set.elements |> List.map (fun value -> `String value)) + in + + let path_to_yojson path = `List (List.map (fun item -> `String item) path) in + + let paths_to_yojson = function + | Impl {cmt; res} -> + `Assoc + [("kind", `String "Impl"); ("cmt", `String cmt); ("res", `String res)] + | Namespace {cmt} -> + `Assoc [("kind", `String "Namespace"); ("cmt", `String cmt)] + | IntfAndImpl {cmti; resi; cmt; res} -> + `Assoc + [ + ("kind", `String "IntfAndImpl"); + ("cmti", `String cmti); + ("resi", `String resi); + ("cmt", `String cmt); + ("res", `String res); + ] + in + + let paths_for_module_to_yojson paths_for_module = + paths_for_module |> Hashtbl.to_seq + |> Seq.map (fun (file, paths) -> (file, paths_to_yojson paths)) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let autocomplete_to_yojson autocomplete = + autocomplete |> Misc.String_map.bindings + |> List.map (fun (name, files) -> + (name, `List (List.map (fun file -> `String file) files))) + |> fun fields -> `Assoc fields + in + + let package_to_yojson (package : package) = + let major, minor = package.rescript_version in + `Assoc + [ + ( "generic_jsx_module", + option_to_yojson + (fun value -> `String value) + package.generic_jsx_module ); + ("suffix", `String package.suffix); + ("root_path", `String package.root_path); + ("project_files", string_set_to_yojson package.project_files); + ("dependencies_files", string_set_to_yojson package.dependencies_files); + ("paths_for_module", paths_for_module_to_yojson package.paths_for_module); + ( "namespace", + option_to_yojson (fun value -> `String value) package.namespace ); + ("opens", `List (List.map path_to_yojson package.opens)); + ( "rescript_version", + `Assoc [("major", `Int major); ("minor", `Int minor)] ); + ("autocomplete", autocomplete_to_yojson package.autocomplete); + ] + in + + let file_to_yojson (file : File.t) = + `Assoc + [ + ("uri", `String (file.uri |> Lsp.Uri.to_string)); + ("module_name", `String file.module_name); + ("stamps_count", `Int (List.length (Stamps.get_entries file.stamps))); + ("structure_name", `String file.structure.name); + ( "structure_docstring", + `List (List.map (fun value -> `String value) file.structure.docstring) + ); + ("structure_items_count", `Int (List.length file.structure.items)); + ] + in + + let cmt_cache = + state.cmt_cache |> Hashtbl.to_seq + |> Seq.map (fun (file_path, file) -> (file_path, file_to_yojson file)) + |> List.of_seq + in + + let root_for_uri = + state.root_for_uri |> Hashtbl.to_seq |> List.of_seq + |> List.map (fun (uri, str) -> [(Lsp.Uri.to_string uri, `String str)]) + |> List.flatten + in + + let packages_by_root = + state.packages_by_root |> Hashtbl.to_seq |> List.of_seq + |> List.map (fun (root, package) -> (root, package_to_yojson package)) + in + + `Assoc + [ + ("cmt_cache", `Assoc cmt_cache); + ("root_for_uri", `Assoc root_for_uri); + ("packages_by_root", `Assoc packages_by_root); + ] diff --git a/dune b/dune index 91a5df6eca9..2903c721981 100644 --- a/dune +++ b/dune @@ -1 +1 @@ -(dirs compiler tests analysis tools) +(dirs compiler tests analysis tools lsp) diff --git a/dune-project b/dune-project index 112c97df1b6..096703eab3c 100644 --- a/dune-project +++ b/dune-project @@ -75,3 +75,21 @@ (yojson (= 3.0.0)) (odoc :with-doc))) + +(package + (name rescript-language-server) + (synopsis "ReScript LSP") + (depends + (ocaml + (>= 4.10)) + (lsp + (>= 1.22.0)) + (eio + (>= 1.3)) + (eio_main + (>= 1.3)) + analysis + dune + ppx_deriving_yojson + (ppx_expect + (and :with-test (= v0.17.2))))) diff --git a/lsp/bin/dune b/lsp/bin/dune new file mode 100644 index 00000000000..5ff2a68c37b --- /dev/null +++ b/lsp/bin/dune @@ -0,0 +1,5 @@ +(executable + (name main) + (package rescript-language-server) + (public_name rescript-language-server) + (libraries rescript_language_server eio_main)) diff --git a/lsp/bin/main.ml b/lsp/bin/main.ml new file mode 100644 index 00000000000..ff07d3a8375 --- /dev/null +++ b/lsp/bin/main.ml @@ -0,0 +1,6 @@ +let () = + Eio_main.run (fun env -> + let fs = Eio.Stdenv.fs env in + let stdin = Eio.Stdenv.stdin env in + let stdout = Eio.Stdenv.stdout env in + Rescript_language_server.listen ~input:stdin ~output:stdout ~fs) diff --git a/lsp/bin/main.mli b/lsp/bin/main.mli new file mode 100644 index 00000000000..e69de29bb2d diff --git a/lsp/lsp.md b/lsp/lsp.md new file mode 100644 index 00000000000..f388ff2ca92 --- /dev/null +++ b/lsp/lsp.md @@ -0,0 +1,410 @@ +# LSP + +# Why rewrite the server in OCaml? + +# Some known problems + +- https://github.com/rescript-lang/rescript/discussions/8099 + +# PR Description + +> Very experimental, WIP!! + +This branch introduces a standalone ReScript LSP server (`rescript-language-server`) built on top of the existing `analysis` library. It's a separate, OCaml-side exploration alongside the Rust/rewatch-based experiment in #8243, the two share the same goal (a LSP server for ReScript) but approach it from different ends of the toolchain. + +## What's here + +- New `lsp/` package split into `lsp/bin` (entrypoint) and `lsp/src` (library), with its own opam file (`rescript-language-server.opam`). Depends on `lsp` (>= 1.22.0), `eio`/`eio_main`, and the in-tree `analysis` library. + +## Status / what's not here yet + +> This Language server implementation require ReScript >=v12.1.0 + +The main objective is to first maintain resource parity with the current server. Below is a list of some requests and notifications. Some are outside the scope because they don't make sense. + +- [x] `initialize` - client request +- [x] `initialized` - client notification +- [x] `shutdown` - client request +- [x] `exit` - client notification +- [x] `textDocument/didOpen` - client notification +- [x] `textDocument/didChange` - client notification + - The server receive the full text +- [x] `textDocument/didClose` - client notification +- [ ] `textDocument/didSave` - client notification - **It will not be implemented for now.** +- [x] `textDocument/hover` - client request +- [x] `textDocument/publishDiagnostics` - server notification + - [x] Need more work with some kind of erros. How publish circular dependency errors? + - Circular dependency diagnostics are special-cased because the compiler log does not point at a precise source range. When the document is open, we expand the diagnostic range to cover the whole document so the editor can display a file-level diagnostic. If the document is not open, we keep the range parsed from the compiler log, i.e, `{start: {line: 0: character: 0}, end: {line: 0, character: 0}}` + - [x] Use `Analysis` for syntax errors and ignore them in the compiler log parser. + - This lets the server publish syntax errors on `TextDocumentDidChange` and provide instant feedback. + - [x] Compiler-log diagnostics from `.compiler.log` - server feature + - [ ] Add more tests cases, see `compiler_log.ml`. See `tests/build_tests` for more examples. + - [ ] Remove support to parse OCaml message + - [x] Monorepo diagnostics via `.sourcedirs.json` - server feature + - Require ReScript v12.1.0. In this version `.sourcedirs.json` is always generated with `build_root` field for each subpackage. + - [ ] Add warning number on message diagnostic. +- [x] `workspace/didChangeWatchedFiles` - client notification + - The server uses this notification to detect changes to generated `.compiler.log` files, which usually means a ReScript build has finished. When a watched log changes, the server re-reads every known compiler log and republishes diagnostics so stale errors are cleared and monorepo diagnostics stay in sync. + - Use GlobPattern with baseUri (workspace root)? + - We should watch all `rescript.json` in workspace? + - Some functionalities require data defined in `rescript.json`. For example, `suffix` and `package-specs` are needed to create the code action `Open compiled js file`. Changes to `dependencies` impact various functionalities because they modify the state in `Analysis.Shared_types.state`. + - User can restart the server when change some config +- [x] `client/registerCapability` - server request + - We use this because `workspace/didChangeWatchedFiles` is commonly registered dynamically. The server does not know all file-watch patterns during the static `initialize` response. In this LSP, the watcher list depends on project state, especially `.sourcedirs.json`, which tells us where each ReScript build root lives. In monorepos, that means the server needs to register watchers for compiler logs after initialization, once it has workspace context. That means watching generated `.compiler.log` files. When the client sees one change, it sends `workspace/didChangeWatchedFiles`, and the server refreshes diagnostics. +- [ ] `textDocument/diagnostic` - client request - **It will not be implemented for now.** +- [x] `textDocument/completion` - client request +- [x] `completionItem/resolve` - client request +- [x] `textDocument/signatureHelp` - client request +- [x] `textDocument/definition` - client request +- [ ] `textDocument/declaration` - client request - **It will not be implemented for now.** +- [x] `textDocument/typeDefinition` - client request +- [ ] `textDocument/implementation` - client request - **It will not be implemented for now.** +- [x] `textDocument/references` - client request + - 🐛 Neovim and Zed kill the server. I need to investigate. +- [ ] `textDocument/documentHighlight` - client request - **It will not be implemented for now.** +- [ ] `textDocument/documentSymbol` - client request + - 🐛 Zed doesn't show the symbols on the panel. It works on Neovim +- [ ] `workspace/symbol` - client request - **It will not be implemented for now.** +- [x] `textDocument/codeAction` - client request + - [x] Code actions from analysis + - [x] Code actions from diagnostics (refactor, quick fixes, etc) + - https://github.com/rescript-lang/rescript-vscode/pull/373 + - [x] Open compiled js file (Trigger workspace execute command `rescript/openCompiled`) + - Available if client support `window/showDocument` + - [x] Create interface file (Trigger workspace execute command `rescript/createInterface`) + - Available if interface dont exists + - [x] Switch to implementation/interface (Trigger workspace execute command `rescript/switchImplementationInterface`) + - Avaliable if client support `window/showDocument` request +- [ ] `codeAction/resolve` - client request - **It will not be implemented for now.** +- [x] `textDocument/codeLens` - client request +- [ ] `workspace/codeLens/refresh` - server request + - https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#codeLens_refresh +- [ ] `codeLens/resolve` - client request - **It will not be implemented for now.** +- [x] `textDocument/inlayHint` - client request +- [ ] `inlayHint/resolve` - client request - **It will not be implemented for now.** +- [x] `textDocument/semanticTokens/full` - client request +- [ ] `textDocument/semanticTokens/full/delta` - client request - **It will not be implemented for now.** +- [ ] `textDocument/semanticTokens/range` - client request - **It will not be implemented for now.** +- [x] `textDocument/rename` - client request +- [x] `textDocument/prepareRename` - client request +- [x] `textDocument/formatting` - client request +- [ ] `textDocument/rangeFormatting` - client request - **It will not be implemented for now.** +- [ ] `textDocument/onTypeFormatting` - client request - **It will not be implemented for now.** +- [ ] `textDocument/foldingRange` - client request - **It will not be implemented for now.** +- [ ] `textDocument/selectionRange` - client request - **It will not be implemented for now.** +- [ ] `textDocument/documentLink` - client request - **It will not be implemented for now.** +- [ ] `documentLink/resolve` - client request - **It will not be implemented for now.** +- [ ] `textDocument/documentColor` - client request - **It will not be implemented for now.** +- [ ] `textDocument/linkedEditingRange` - client request - **It will not be implemented for now.** +- [x] `workspace/didChangeConfiguration` - client notification +- [x] `workspace/configuration` - server request +- [x] `workspace/executeCommand` - client request + - [x] `rescript/dumpServerState` + - Dump the `State.t` (diagnostics, document store, status, analysis state (`Analysis.Shared_types.state`) and compiler config). + - [x] `rescript/openCompiled`: Trigged by a code action + - Only work if client support `window/showDocument` + - [x] `rescript/createInterface`: Trigged by a code action + - Server create interface if dont exists and open the interface file if client support `window/showDocument` request. + - If interface file already exists server send a error + - [x] `rescript/switchImplementationInterface`: Trigged by a code action + - Only avaliable if client support `window/showDocument` request + - Flow to execute a command: + - ``` + CodeAction.command = "rescript/commandName" + ↓ + workspace/executeCommand handler + ↓ + server sends window/showDocument + ↓ + client opens file + ``` + - Zed does not support the `window/showDocument` request. https://github.com/zed-industries/zed/discussions/58099. +- [x] Custom requests + - [x] `textDocument/openCompiled` - client request + - [x] `textDocument/createInterface` - client request + - [x] `textDocument/switchImplementationInterface`: Currently it's done on the client side, but it could be a command trigged by a code action. + - Move to code action feature + - [ ] `rescript/startBuild` - client request - **How the build integration will be done** + - Some questions + - Build should be managed by the server? + - Create a setting to automatically start the build watcher on initilization and drop this custom request? + - When kill the build watcher? Shutdown/Exit? + - Create work done progress? + - Add a custom request to kill the watcher `rescript/stopBuild`? +- [ ] Custom notifications + - [ ] `rescript/compilationFinished` - server notification - Send from the server to client when compilation is finished + - The server (server.ts) send this notification and VSCode client use to run Code Analysis. The server send when the `.compiler` log changes. Only VSCode use this notification. + - We should use progress support `$/progress` server notification? + - [ ] `rescript/compilationStatus` - server notification - Send compilation status from the server to client. + - VSCode use this notification to show status of compilation on status bar. Only VSCode use this notification. + - We should use progress support `$/progress` server notification? +- [ ] Incremental compilation - server feature +- [ ] Build integration managed by the LSP server - server feature + - Build integration is still external: diagnostics come from compiler logs produced by an existing `rescript build`, rather than the LSP starting or managing builds itself. +- [ ] Support two channels: `stdio` and `socket`? + +## Tests + +`tests/lsp_tests/` adds a dune-driven integration test (`test.ml`) that boots the server against a real ReScript workspace (`basic-workspace/`), initializes the LSP session, sends the `initialized` notification, opens source documents, and snapshots responses for representative fixtures. + +The LSP test target now also runs `dune runtest`, covering inline tests such as `.sourcedirs.json` build-root, `.compiler.log` parsing used by diagnostics and file-watcher setup. + +## Server settings + +Proposed interface. Some notes: + +- Currently, `supportMarkdownLinks` is not a setting. It's a great feature, but some clients don't have good support; Neovim is an example. Therefore, I'm promoting it to a setting. This feature is great in VSCode and Zed. +- I think we should remove `signatureHelp.enable`. It's a basic feature on many servers. + +```ts +/** + * Server settings. + * These configurations are request by the server using `workspace/configuration` + */ +interface Settings { + hover?: { + /** + * Enable markdown links in hover responses + * @default false + */ + supportMarkdownLinks?: boolean; + }; + /** + * Enable code lenses to function definitions, showing its full type above the definition + * @default false + */ + codeLens?: boolean; + /** + * Place annotations inline with text to display type hints + */ + inlayHints?: { + /** + * Enable inlay hints + * @default false + */ + enable?: boolean; + /** + * Maximum length of character for inlay hints. Set to null to have an unlimited length. + * Inlay hints that exceed the maximum length will not be shown + * @default 25 + */ + maxLength?: number | null; + }; + /** + * Signature help + */ + signatureHelp?: { + /** + * Enable signature help + * @default true + */ + enable?: boolean; + /** + * Enable signature help for variant constructors + * @default true + */ + forConstructorPayloads?: boolean; + }; +} +``` + +## Release and transition plan + +> TODO: How publish the server? How dev use the new alpha version? Describe a transition plan. + +Some observations for testing the alpha version. + +#### VSCode/Zed users + +- It should be a standalone package (`@rescript/language-server`?) so the user can install it as a development dependency or globally. VSCode/Zed can get it from `node_modules/.bin/rescript-language-server` or from the `$PATH`. +- It should be a basic configuration, for example `rescript.useExperimentalServer: bool` in VSCode and `rescript-language-server.useExperimentalServer: bool` under `lsp` section on Zed. + - Clients can download and install the language server from npm? +- It shouldn't be bundled with the VSCode extensison client as a pre-release version. Switching between extension versions is annoying. + +#### Neovim users + +The new server require some changes on setup of lsp. Use `root_dir` handler function instead of `root_markers`. + +```lua +--- Search for `node_modules/.bin/rescript-language-server` in current working directory +local new_rescript_ls_cmd = vim.fs.joinpath( + vim.uv.cwd(), + 'node_modules', + '.bin', + 'rescript-language-server' +) +local new_rescript_ls_installed = vim.fn.executable(new_rescript_ls_cmd) == 1 + +local capabilities = vim.lsp.protocol.make_client_capabilities() +-- Enable workspace.didChangeWatchedFiles capabilities +capabilities.workspace.didChangeWatchedFiles.dynamicRegistration = true + +---@param client vim.lsp.Client +---@param bufnr integer +local dump_server_state = function(client, bufnr) + client:exec_cmd({ + title = 'ReScript Dump server state', + command = 'rescript/dumpServerState', + }, { bufnr = bufnr }, function(err, result) + if err then + vim.notify(tostring(err), vim.log.levels.ERROR) + return + end + + if not result or type(result.content) ~= 'string' then + vim.notify('Invalid server response', vim.log.levels.ERROR) + return + end + + local content = result.content + + -- Create an listed scratch buffer. + local dump_buf = vim.api.nvim_create_buf(true, true) + + vim.api.nvim_buf_set_name( + dump_buf, + 'rescriptls://rescript-dump-server-state' + ) + + -- Do not specify the file type to avoid freezing with syntax highlighting using Treesitter. The state is a large JSON file. + vim.bo[dump_buf].buftype = 'nofile' + vim.bo[dump_buf].bufhidden = 'wipe' + vim.bo[dump_buf].swapfile = false + + -- Open it in the current window. + vim.api.nvim_set_current_buf(dump_buf) + + -- Fill buffer with content. + local lines = vim.split(content, '\n', { plain = true }) + vim.api.nvim_buf_set_lines(dump_buf, 0, -1, false, lines) + + -- Optional: make it read-only after writing. + vim.bo[dump_buf].modifiable = false + vim.bo[dump_buf].readonly = true + end) +end + +if new_rescript_ls_installed then + -- Dot notation defines a new configuration instead of extending one with + -- vim.lsp.config(name, cfg). + vim.lsp.config.rescriptls = { + cmd = { new_rescript_ls_cmd }, + filestypes = { 'rescript' }, + -- Prefer root_dir over root_markers for monorepos. root_markers stops at + -- the nearest rescript.json, which may be a package inside the monorepo. + -- The ReScript LSP needs the workspace root instead, because package + -- discovery, lock files, and build roots are resolved from the directory + -- where Neovim was opened. + -- This root_dir callback first finds the repository root, then falls back to + -- the package-manager lockfile root. It only starts the server when that + -- root contains a ReScript project. + root_dir = function(bufnr, on_dir) + local fname = vim.api.nvim_buf_get_name(bufnr) + -- Find the repository root. + local git_dir = + vim.fs.dirname(vim.fs.find('.git', { path = fname, upward = true })[1]) + -- Monorepos usually keep one lock file at the workspace root. + local lock_file_dir = vim.fs.dirname( + vim.fs.find( + { 'yarn.lock', 'package-lock.json' }, + { path = fname, upward = true } + )[1] + ) + + if + (git_dir and vim.fs.root(git_dir, 'rescript.json')) + or (lock_file_dir and vim.fs.root(lock_file_dir, 'rescript.json')) + then + on_dir(git_dir or lock_file_dir) + end + end, + ---@param client vim.lsp.Client + ---@param bufnr integer + on_attach = function(client, bufnr) + vim.api.nvim_buf_create_user_command( + bufnr, + 'LspDumpServerState', + function() + dump_server_state(client, bufnr) + end, + { desc = 'rescriptls: Dump server state' } + ) + on_attach(client, bufnr) + end, + capabilities = capabilities, + settings = { + rescript = { + hover = { + supportMarkdownLinks = true, + }, + codeLens = true, + inlayHints = { + enable = true, + maxLength = 25, + }, + signatureHelp = { + enable = true, + forConstructorPayloads = true, + }, + }, + }, + } +else + vim.lsp.config('rescriptls', { + init_options = { + extensionConfiguration = { + askToStartBuild = false, + codeLens = false, + signatureHelp = { + enable = true, + }, + inlayHints = { + enable = true, + }, + incrementalTypechecking = { + enabled = true, + }, + }, + }, + on_attach = function(client, bufnr) + local ok, rescript_tools = pcall(require, 'rescript-tools') + if ok then + local commands = { + ResOpenCompiled = rescript_tools.open_compiled, + ResCreateInterface = rescript_tools.create_interface, + ResSwitchImplInt = rescript_tools.switch_impl_intf, + } + for name, fn in pairs(commands) do + vim.api.nvim_buf_create_user_command( + bufnr, + name, + fn, + { desc = 'ReScript LSP: ' .. name } + ) + end + end + on_attach(client, bufnr) + end, + }) +end +``` + +## Other topics related + +## Refactor analysis to use on server side + +- Parsing from source (not just files) / decouple I/O from core logic #8426 #8466 +- Use `yojson` and `lsp` library for analysis library #8436 +- Remove global state `Shared_types.state` #8465 + +### Relationship to #8243 + +#8243 collapses the build watcher and LSP into a single Rust process in rewatch, shelling out to `rescript-editor-analysis.exe` over stdin. This PR keeps the LSP on the OCaml side and uses the `analysis` library directly. Useful as a comparison point for the architecture discussion. + +## Other TODO + +- Add README.md for `lsp` folder +- Add CHANGELOG.md? +- Document custom requests/notification +- Configure CI to publish the server on npm + - Trigger event: push commit message format on master branch? diff --git a/lsp/src/code_actions.ml b/lsp/src/code_actions.ml new file mode 100644 index 00000000000..77c02b4786b --- /dev/null +++ b/lsp/src/code_actions.ml @@ -0,0 +1,528 @@ +open Lsp +open Types + +module From_diagnostics : sig + val get : + uri:Uri.t -> + diagnostics:Diagnostic.t list -> + source:string -> + CodeAction.t list +end = struct + let diagnostic_message (diagnostic : Diagnostic.t) = + match diagnostic.message with + | `String message -> message + | `MarkupContent {value} -> value + + let ansi_escape_regex = Str.regexp "\027\\[[0-9;]*m" + let whitespace_regex = Str.regexp "[ \t\r\n]+" + + let strip_ansi str = Str.global_replace ansi_escape_regex "" str + + let empty_range position = Range.create ~start:position ~end_:position + + let replace_text range new_text = [TextEdit.create ~range ~newText:new_text] + + let spaces length = String.make (max 0 length) ' ' + + let quick_fix ~uri ~diagnostic ~title ~edits = + let edit = WorkspaceEdit.create ~changes:[(uri, edits)] () in + Some + (CodeAction.create ~title ~edit ~diagnostics:[diagnostic] + ~kind:CodeActionKind.QuickFix ~isPreferred:true ()) + + let insert_before_ending_char (range : Range.t) new_text = + let position = + Position.create ~line:range.end_.line + ~character:(max 0 (range.end_.character - 1)) + in + [TextEdit.create ~range:(empty_range position) ~newText:new_text] + + let wrap_range_in_text (range : Range.t) before after = + [ + TextEdit.create ~range:(empty_range range.start) ~newText:before; + TextEdit.create ~range:(empty_range range.end_) ~newText:after; + ] + + let split_fields fields = + fields |> String.trim |> Str.split (Str.regexp "[ \t\r\n]+") + + let drop_prefix ~prefix line = + let line = String.trim line in + if String.starts_with ~prefix line then + let prefix_length = String.length prefix in + Some (String.sub line prefix_length (String.length line - prefix_length)) + else None + + let before_first_dot line = + match String.index_opt line '.' with + | Some index -> String.sub line 0 index + | None -> line + + let before_defined_as typ = + match Str.search_forward (Str.regexp_string "(defined as") typ 0 with + | index -> String.sub typ 0 index + | exception Not_found -> typ + + let extract_typename lines = + lines |> String.concat " " |> strip_ansi |> before_defined_as |> String.trim + |> Str.global_replace whitespace_regex "" + + let line_starts_with ~prefix line = + line |> strip_ansi |> String.trim |> String.starts_with ~prefix + + let did_you_mean ~uri ~diagnostic = + let did_you_mean_prefix = "Hint: Did you mean" in + let did_you_mean_regex = Str.regexp "Did you mean \\([A-Za-z0-9_]+\\)" in + + let suggestion_from_line line = + match Str.search_forward did_you_mean_regex line 0 with + | _ -> Some (Str.matched_group 1 line) + | exception Not_found -> None + in + + let find_did_you_mean_line message = + message |> String.split_on_char '\n' + |> List.find_opt (fun line -> + String.starts_with ~prefix:did_you_mean_prefix (String.trim line)) + in + + let message = diagnostic_message diagnostic in + + match find_did_you_mean_line message with + | None -> None + | Some line -> ( + match suggestion_from_line line with + | None -> None + | Some suggestion -> + let edit = + WorkspaceEdit.create + ~changes: + [ + ( uri, + [TextEdit.create ~range:diagnostic.range ~newText:suggestion] + ); + ] + () + in + Some + (CodeAction.create + ~title:(Printf.sprintf "Replace with '%s'" suggestion) + ~edit ~diagnostics:[diagnostic] ~kind:CodeActionKind.QuickFix + ~isPreferred:true ())) + + let wrap_in_some ~uri ~diagnostic = + let pattern_prefix = "This pattern matches values of type" in + let pattern_type_regex = + Str.regexp "This pattern matches values of type \\(.*\\)$" + in + let expected_type_prefix = + "but a pattern was expected which matches values of type" + in + let expected_type_regex = + Str.regexp + "but a pattern was expected which matches values of type\\(.*\\)$" + in + let option_type_regex = Str.regexp_string "option<" in + let is_option_type typ = + match Str.search_forward option_type_regex typ 0 with + | _ -> true + | exception Not_found -> false + in + let type_from_pattern_line line = + match Str.search_forward pattern_type_regex line 0 with + | _ -> Some (String.trim (Str.matched_group 1 line)) + | exception Not_found -> None + in + let type_from_expected_line line = + match Str.search_forward expected_type_regex line 0 with + | _ -> Some (String.trim (Str.matched_group 1 line)) + | exception Not_found -> None + in + let rec expected_type lines = + match lines with + | [] -> None + | line :: next_lines -> + if String.starts_with ~prefix:expected_type_prefix (String.trim line) + then + match type_from_expected_line line with + | Some typ when typ <> "" -> Some typ + | _ -> ( + match next_lines with + | next_line :: _ -> Some (String.trim next_line) + | [] -> None) + else expected_type next_lines + in + let message = diagnostic_message diagnostic in + let lines = String.split_on_char '\n' message in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> + if String.starts_with ~prefix:pattern_prefix (String.trim line) then + match type_from_pattern_line line with + | Some actual_type when not (is_option_type actual_type) -> ( + match expected_type rest with + | Some expected_type when is_option_type expected_type -> + let edit = + WorkspaceEdit.create + ~changes: + [(uri, wrap_range_in_text diagnostic.range "Some(" ")")] + () + in + Some + (CodeAction.create ~title:"Wrap in option Some" ~edit + ~diagnostics:[diagnostic] ~kind:CodeActionKind.QuickFix + ~isPreferred:true ()) + | _ -> None) + | _ -> None + else loop rest + in + loop lines + + let simple_conversion ~uri ~(diagnostic : Diagnostic.t) = + let prefix = "You can convert " in + let conversion_regex = + Str.regexp + "You can convert \\([A-Za-z0-9_]+\\) to \\([A-Za-z0-9_]+\\) with \ + \\([A-Za-z0-9_.]+\\)\\.$" + in + let code_action_from_line line = + let line = line |> strip_ansi |> String.trim in + if String.starts_with ~prefix line then + match Str.search_forward conversion_regex line 0 with + | _ -> + let from_type = Str.matched_group 1 line in + let to_type = Str.matched_group 2 line in + let fn = Str.matched_group 3 line in + quick_fix ~uri ~diagnostic + ~title: + (Printf.sprintf "Convert %s to %s with %s" from_type to_type fn) + ~edits:(wrap_range_in_text diagnostic.range (fn ^ "(") ")") + | exception Not_found -> None + else None + in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> ( + match code_action_from_line line with + | Some _ as code_action -> code_action + | None -> loop rest) + in + diagnostic |> diagnostic_message |> String.split_on_char '\n' |> loop + + let apply_uncurried ~uri ~(diagnostic : Diagnostic.t) = + let prefix = + "This is an uncurried ReScript function. It must be applied with a dot." + in + let make_code_action () = + let position = + Position.create ~line:diagnostic.range.end_.line + ~character:(diagnostic.range.end_.character + 1) + in + quick_fix ~uri ~diagnostic ~title:"Apply uncurried function call with dot" + ~edits:[TextEdit.create ~range:(empty_range position) ~newText:". "] + in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> + if line_starts_with ~prefix line then make_code_action () else loop rest + in + diagnostic |> diagnostic_message |> String.split_on_char '\n' |> loop + + let simple_add_missing_cases ~uri ~(diagnostic : Diagnostic.t) ~source = + let prefix = "You forgot to handle a possible case here, for example:" in + let make_code_action hint = + match + Analysis.Codemod.transform_opt ~source + ~pos:(diagnostic.range.start.line, diagnostic.range.start.character) + ~debug:false ~typ:Analysis.Codemod.AddMissingCases ~hint + with + | None -> None + | Some new_switch_code -> + quick_fix ~uri ~diagnostic ~title:"Insert missing cases" + ~edits:(replace_text diagnostic.range new_switch_code) + in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> + if line_starts_with ~prefix line then + let hint = rest |> String.concat "" |> String.trim in + if hint = "" then None else make_code_action hint + else loop rest + in + diagnostic |> diagnostic_message |> String.split_on_char '\n' |> loop + + let simple_type_mismatches ~uri ~(diagnostic : Diagnostic.t) = + let this_has_type_prefix = "This has type:" in + let somewhere_wanted_prefix = "Somewhere wanted:" in + let default_value = function + | "string" -> "\"-\"" + | "bool" -> "false" + | "int" -> "-1" + | "float" -> "-1." + | _ -> "assert false" + in + let rec collect_until_somewhere_wanted acc lines = + match lines with + | [] -> None + | line :: rest -> ( + match drop_prefix ~prefix:somewhere_wanted_prefix line with + | Some wanted -> Some (List.rev acc, wanted, rest) + | None -> collect_until_somewhere_wanted (line :: acc) rest) + in + let rec collect_until_blank acc lines = + match lines with + | [] -> List.rev acc + | line :: rest -> + if line |> strip_ansi |> String.trim = "" then List.rev acc + else collect_until_blank (line :: acc) rest + in + let code_action_from_types ~actual_type ~wanted_type = + if actual_type = Printf.sprintf "option<%s>" wanted_type then + quick_fix ~uri ~diagnostic ~title:"Unwrap optional value" + ~edits: + (wrap_range_in_text diagnostic.range "switch " + (Printf.sprintf " { | None => %s | Some(v) => v }" + (default_value wanted_type))) + else if Printf.sprintf "option<%s>" actual_type = wanted_type then + quick_fix ~uri ~diagnostic ~title:"Wrap value in Some" + ~edits:(wrap_range_in_text diagnostic.range "Some(" ")") + else None + in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> ( + match drop_prefix ~prefix:this_has_type_prefix line with + | None -> loop rest + | Some actual -> ( + match collect_until_somewhere_wanted [actual] rest with + | None -> None + | Some (actual_lines, wanted, rest) -> + let wanted_lines = wanted :: collect_until_blank [] rest in + let actual_type = extract_typename actual_lines in + let wanted_type = extract_typename wanted_lines in + code_action_from_types ~actual_type ~wanted_type)) + in + diagnostic |> diagnostic_message |> String.split_on_char '\n' |> loop + + let handle_undefined_record_fields ~uri ~(diagnostic : Diagnostic.t) + ~record_field_names ~todo_value = + match record_field_names with + | [] -> None + | _ -> + let range = diagnostic.range in + let multiline_record_definition_body = + range.start.line <> range.end_.line + in + let new_text = + if multiline_record_definition_body then + let padding_content_record_field = + spaces (range.end_.character + 1) + in + let padding_content_end_brace = spaces (range.end_.character - 1) in + let fields = + record_field_names + |> List.mapi (fun index field_name -> + let padding = + if index = 0 then " " else padding_content_record_field + in + Printf.sprintf "%s%s: %s,\n" padding field_name todo_value) + |> String.concat "" + in + fields ^ padding_content_end_brace + else + let prefix = + if range.end_.character - range.start.character > 2 then ", " + else "" + in + let fields = + record_field_names + |> List.map (fun field_name -> + Printf.sprintf "%s: %s" field_name todo_value) + |> String.concat ", " + in + prefix ^ fields + in + let edit = + WorkspaceEdit.create + ~changes:[(uri, insert_before_ending_char range new_text)] + () + in + Some + (CodeAction.create ~title:"Add missing record fields" ~edit + ~diagnostics:[diagnostic] ~kind:CodeActionKind.QuickFix + ~isPreferred:true ()) + + let add_undefined_record_fields_v10 ~uri ~diagnostic = + let prefix = "Some record fields are undefined:" in + let message = diagnostic_message diagnostic in + let lines = String.split_on_char '\n' message in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> ( + match drop_prefix ~prefix line with + | None -> loop rest + | Some fields -> + let record_field_names = + split_fields fields @ (rest |> List.concat_map split_fields) + in + (* TODO: Use %todo? *) + handle_undefined_record_fields ~uri ~diagnostic ~record_field_names + ~todo_value:"failwith(\"TODO\")") + in + loop lines + + let add_undefined_record_fields_v11 ~uri ~diagnostic = + let prefix = "Some required record fields are missing:" in + let message = diagnostic_message diagnostic in + let lines = String.split_on_char '\n' message in + let rec collect_until_dot acc lines = + match lines with + | [] -> List.rev acc + | line :: rest -> + let fields = line |> before_first_dot |> split_fields in + let acc = List.rev_append fields acc in + if String.contains line '.' then List.rev acc + else collect_until_dot acc rest + in + let rec loop lines = + match lines with + | [] -> None + | line :: rest -> ( + match drop_prefix ~prefix line with + | None -> loop rest + | Some fields -> + let record_field_names = + split_fields (before_first_dot fields) + @ if String.contains line '.' then [] else collect_until_dot [] rest + in + handle_undefined_record_fields ~uri ~diagnostic ~record_field_names + ~todo_value:"%todo") + in + loop lines + + let extractor ~uri ~diagnostic ~source = + let code_actions = ref [] in + + let append code_action = + match code_action with + | Some code_action -> code_actions := code_action :: !code_actions + | None -> () + in + + did_you_mean ~uri ~diagnostic |> append; + wrap_in_some ~uri ~diagnostic |> append; + simple_conversion ~uri ~diagnostic |> append; + apply_uncurried ~uri ~diagnostic |> append; + simple_add_missing_cases ~uri ~diagnostic ~source |> append; + simple_type_mismatches ~uri ~diagnostic |> append; + add_undefined_record_fields_v10 ~uri ~diagnostic |> append; + add_undefined_record_fields_v11 ~uri ~diagnostic |> append; + + !code_actions + + let get ~uri ~diagnostics ~source = + diagnostics + |> List.map (fun diagnostic -> extractor ~uri ~diagnostic ~source) + |> List.flatten + (* diagnostics + |> Diagnostics.Uri_map.mapi (fun uri diagnostics -> + diagnostics + |> List.map (fun diagnostic -> extractor ~uri ~diagnostic) + |> List.flatten) *) +end + +module Open_compiled_file = struct + let create ~(uri : Uri.t) ~(state : State.t) = + let compiled_uri = + Helpers.get_compiled_file ~uri + ~compiler_config:(State.compiler_config state) + ~fs:state.fs + ~workspace_root:(State.workspace_root state) + in + match compiled_uri with + | Some uri -> + let title = "Open compiled file" in + [ + CodeAction.create + ~command: + (Command.create + ~arguments:[`String (Uri.to_string uri)] + ~command:Execute_commands.open_compiled ~title ()) + ~title (); + ] + | None -> [] +end + +module Create_interface_file = struct + let create ~uri ~(state : State.t) = + let should_create = + match Document.kind uri with + | Res -> + not (Fs.exists ~fs:state.fs ~follow:false (Uri.to_path uri ^ "i")) + | _ -> false + in + + let cmi_file = + Helpers.get_cmi_file ~uri ~fs:state.fs + ~compiler_config:(State.compiler_config state) + ~workspace_root:(State.workspace_root state) + in + + match (should_create, cmi_file) with + | true, Some cmi_file -> + let title = "Create interface file" in + [ + CodeAction.create + ~command: + (Command.create + ~arguments: + [ + `String (Uri.to_string uri); + `String (Uri.of_path cmi_file |> Uri.to_string); + ] + ~command:Execute_commands.create_interface ~title ()) + ~title (); + ] + | _ -> [] +end + +module Switch_implementation_interface_file = struct + let create ~uri ~(state : State.t) = + match Document.kind uri with + | Res -> + let target = Uri.to_path uri ^ "i" in + if Fs.exists ~follow:false ~fs:state.fs target then + let title = "Switch to interface file" in + [ + CodeAction.create + ~command: + (Command.create + ~arguments:[`String (Uri.of_path target |> Uri.to_string)] + ~command:Execute_commands.switch_implementation_interface + ~title ()) + ~title (); + ] + else [] + | Resi -> + let target = (Uri.to_path uri |> Filename.remove_extension) ^ ".res" in + if Fs.exists ~follow:false ~fs:state.fs target then + let title = "Switch to implementation file" in + [ + CodeAction.create + ~command: + (Command.create + ~arguments:[`String (Uri.of_path target |> Uri.to_string)] + ~command:Execute_commands.switch_implementation_interface + ~title ()) + ~title (); + ] + else [] + (* TODO: I can have a resi file without a res file *) + | _ -> [] +end diff --git a/lsp/src/compiler_config.ml b/lsp/src/compiler_config.ml new file mode 100644 index 00000000000..017dc1d25f4 --- /dev/null +++ b/lsp/src/compiler_config.ml @@ -0,0 +1,255 @@ +module Parse = struct + type namespace = Namespace_bool of bool | Namespace_string of string + + let namespace_to_yojson = function + | Namespace_bool value -> `Bool value + | Namespace_string value -> `String value + + let namespace_of_yojson = function + | `Bool value -> Ok (Namespace_bool value) + | `String value -> Ok (Namespace_string value) + | json -> + Error + ("Expected namespace to be a boolean or string, got " + ^ Yojson.Safe.to_string json) + + type module_format = Commonjs | Es6 | Es6_global | Esmodule + + let module_format_to_yojson = function + | Commonjs -> `String "commonjs" + | Es6 -> `String "es6" + | Es6_global -> `String "es6-global" + | Esmodule -> `String "esmodule" + + let module_format_of_yojson = function + | `String "commonjs" -> Ok Commonjs + | `String "es6" -> Ok Es6 + | `String "es6-global" -> Ok Es6_global + | `String "esmodule" -> Ok Esmodule + | _ -> Error "Compiler_config.module_format" + + type module_format_object = { + in_source: bool option; [@key "in-source"] [@default None] + module_: module_format; [@key "module"] + suffix: string option; [@default None] + } + [@@deriving yojson {strict = false}] + + type package_spec = + | Module_format of module_format + | Module_format_object of module_format_object + + let package_spec_to_yojson = function + | Module_format module_format -> module_format_to_yojson module_format + | Module_format_object module_format_object -> + module_format_object_to_yojson module_format_object + + let package_spec_of_yojson json = + match module_format_of_yojson json with + | Ok module_format -> Ok (Module_format module_format) + | Error _ -> ( + match module_format_object_of_yojson json with + | Ok module_format_object -> + Ok (Module_format_object module_format_object) + | Error message -> Error message) + + type package_specs = package_spec list + + let package_specs_to_yojson package_specs = + `List (List.map package_spec_to_yojson package_specs) + + let package_specs_of_yojson json = + let rec collect = function + | [] -> Ok [] + | json :: rest -> ( + match package_spec_of_yojson json with + | Ok package_spec -> ( + match collect rest with + | Ok package_specs -> Ok (package_spec :: package_specs) + | Error _ as error -> error) + | Error _ as error -> error) + in + + match json with + | `List package_specs -> collect package_specs + | json -> ( + match package_spec_of_yojson json with + | Ok package_spec -> Ok [package_spec] + | Error _ as error -> error) + + type t = { + name: string; + namespace: namespace option; [@default None] + package_specs: package_specs option; [@key "package-specs"] [@default None] + suffix: string option; [@default None] + } + [@@deriving yojson {strict = false}] + + let%expect_test "parse build schema" = + let prin_config config = + match config with + | Error message -> print_endline ("Error: " ^ message) + | Ok config -> ( + Printf.printf "name=%s\n" config.name; + (match config.namespace with + | Some (Namespace_string namespace) -> + Printf.printf "namespace=%s\n" namespace + | Some (Namespace_bool namespace) -> + Printf.printf "namespace=%b\n" namespace + | None -> print_endline "namespace=none"); + (match config.package_specs with + | Some [Module_format Esmodule; Module_format_object {in_source}] -> + Printf.printf "package_specs=ok in_source=%b\n" + (Option.value in_source ~default:false) + | Some _ -> print_endline "package_specs=other" + | None -> print_endline "package_specs=none"); + match config.suffix with + | Some suffix -> Printf.sprintf "suffix=%s" suffix |> print_endline + | None -> print_endline "suffix=none") + in + + let json = + Yojson.Safe.from_string + {|{ + "name": "app", + "namespace": "App", + "package-specs": [ + "esmodule", + { + "in-source": true, + "module": "commonjs", + "suffix": ".cjs" + } + ], + "suffix": ".js" + }|} + in + prin_config (of_yojson json); + [%expect + {| + name=app + namespace=App + package_specs=ok in_source=true + suffix=.js |}]; + + let json_2 = + Yojson.Safe.from_string + {|{ + "name": "@rescript-lang/guide", + "namespace": false, + "dependencies": [ + "@rescript-lang/playground", + "@rescript-lang/shared", + "@rescript/react", + "@rescript/webapi" + ], + "compiler-flags": ["-open WebAPI.Global"], + "sources": [ + { + "dir": "__tests__", + "subdirs": true, + "type": "dev" + }, + { + "dir": "app", + "subdirs": true + } + ], + "warnings": { + "error": "+8" + } + }|} + in + prin_config (of_yojson json_2); + [%expect + {| + name=@rescript-lang/guide + namespace=false + package_specs=none + suffix=none |}]; + + let json_3 = + Yojson.Safe.from_string + {|{ + "name": "rescript-lang.org-monorepo", + "dependencies": [ + "@rescript-lang/shared", + "@rescript-lang/playground", + "@rescript-lang/guide", + "@rescript-lang/docs" + ], + "sources": [], + "jsx": { + "preserve": true, + "version": 4 + }, + "package-specs": { + "module": "esmodule", + "in-source": true + }, + "suffix": ".jsx" + } +|} + in + prin_config (of_yojson json_3); + [%expect + {| + name=rescript-lang.org-monorepo + namespace=none + package_specs=other + suffix=.jsx + |}] +end + +module Uri_map = Map.Make (Lsp.Uri) + +type t = Parse.t Uri_map.t + +let parse ~root ~fs = + let ( /+ ) = Filename.concat in + let rescript_json = root /+ "rescript.json" in + match Fs.load ~fs rescript_json with + | Some content -> ( + match Yojson.Safe.from_string content with + | json -> ( + match Parse.of_yojson json with + | Ok s -> Ok s + | Error _ -> Error ("Failed to parse rescript.json at " ^ rescript_json)) + | exception _ -> Error ("Failed to parse rescript.json at " ^ rescript_json) + ) + | None -> Error ("Failed to read rescript.json file at " ^ rescript_json) + +(* TODO: Rename this function *) +let get_suffix_and_folder (config : Parse.t) = + let default_suffix = ".js" in + let default_in_source = false in + let folder_name = function + | Parse.Commonjs -> "js" + | Es6_global -> "es6_global" + | Es6 | Esmodule -> "es6" + in + match config.package_specs with + | Some pkg_spec -> ( + match pkg_spec with + | [] -> + ( config.suffix |> Option.value ~default:default_suffix, + folder_name Parse.Commonjs, + default_in_source ) + | Module_format module_ :: _ -> + ( config.suffix |> Option.value ~default:default_suffix, + folder_name module_, + default_in_source ) + | Module_format_object {module_; suffix; in_source} :: _ -> + let suffix = + match (suffix, config.suffix) with + | Some s, _ -> s + | None, Some s -> s + | _ -> default_suffix + in + ( suffix, + folder_name module_, + in_source |> Option.value ~default:default_in_source )) + | None -> + ( config.suffix |> Option.value ~default:default_suffix, + folder_name Parse.Commonjs, + default_in_source ) diff --git a/lsp/src/compiler_log.ml b/lsp/src/compiler_log.ml new file mode 100644 index 00000000000..614956575fc --- /dev/null +++ b/lsp/src/compiler_log.ml @@ -0,0 +1,1213 @@ +module Parse : sig + type path = Relative_path of string | Full_path of string + + type entry = + | Syntax_error + | Warning + | Common_error (* type error, value can't be found *) + | Circular_dependency + | Unknow + + type diagnostic_entry = {entry: entry; diagnostic: Lsp.Types.Diagnostic.t} + + val parse_log_content : string -> (path * diagnostic_entry) list +end = struct + type position = {line: int; col: int} + + type range = {start_pos: position; end_pos: position} + + type path = Relative_path of string | Full_path of string + + type entry = + | Syntax_error + | Warning + | Common_error + | Circular_dependency + | Unknow + + type diagnostic_entry = {entry: entry; diagnostic: Lsp.Types.Diagnostic.t} + + type location_format = Path_location | File_location + + let split_lines s = s |> String.split_on_char '\n' |> Array.of_list + + let is_blank s = String.trim s = "" + + let starts_with prefix s = + let prefix_len = String.length prefix in + String.length s >= prefix_len && String.sub s 0 prefix_len = prefix + + let ends_with suffix s = + let suffix_len = String.length suffix in + let len = String.length s in + len >= suffix_len && String.sub s (len - suffix_len) suffix_len = suffix + + let is_rescript_source_path s = + (not (String.contains s ' ')) + && List.exists + (fun suffix -> ends_with suffix s) + [".res"; ".resi"; ".re"; ".rei"] + + let filepath_of_path path = + if Filename.is_relative path then Relative_path path else Full_path path + + let zero_range = + {start_pos = {line = 0; col = 0}; end_pos = {line = 0; col = 0}} + + let parse_path_location line = + (* Supported formats: + + /path/file.res:3:9 + start = 3:9 + end = 3:9 + + /path/file.res:3:5-8 + start = 3:5 + end = 3:8 + + /path/file.res:1:8-2:3 + start = 1:8 + end = 2:3 + + /path/file.res + start = 0:0 + end = 0:0 + *) + let line = String.trim line in + + let point_re = Str.regexp "^\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)$" in + let same_line_range_re = + Str.regexp "^\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$" + in + let cross_line_range_re = + Str.regexp + "^\\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\):\\([0-9]+\\)$" + in + let make_location filepath start_line start_col end_line end_col = + Some + ( filepath_of_path (Str.matched_group filepath line), + { + start_pos = + { + line = Str.matched_group start_line line |> int_of_string; + col = Str.matched_group start_col line |> int_of_string; + }; + end_pos = + { + line = Str.matched_group end_line line |> int_of_string; + col = Str.matched_group end_col line |> int_of_string; + }; + } ) + in + + try + if Str.string_match cross_line_range_re line 0 then + make_location 1 2 3 4 5 + else if Str.string_match same_line_range_re line 0 then + make_location 1 2 3 2 4 + else if Str.string_match point_re line 0 then make_location 1 2 3 2 3 + else if is_rescript_source_path line then + Some (filepath_of_path line, zero_range) + else None + with Not_found | Failure _ -> + if is_rescript_source_path line then + Some (filepath_of_path line, zero_range) + else None + + let parse_file_location line = + (* Supported formats: + + File "/path/file.res", line 3, characters 5-8: + start = 3:5 + end = 3:8 + + File "/path/file.res", lines 11-13, characters 6-7: + start = 11:6 + end = 13:7 + *) + let line = String.trim line in + + let single_line_re = + Str.regexp + "^File \"\\([^\"]+\\)\", line \\([0-9]+\\), characters \ + \\([0-9]+\\)-\\([0-9]+\\):$" + in + let multi_line_re = + Str.regexp + "^File \"\\([^\"]+\\)\", lines \\([0-9]+\\)-\\([0-9]+\\), characters \ + \\([0-9]+\\)-\\([0-9]+\\):$" + in + + if Str.string_match single_line_re line 0 then + let filepath = Str.matched_group 1 line in + let line_number = Str.matched_group 2 line |> int_of_string in + let start_col = Str.matched_group 3 line |> int_of_string in + let end_col = Str.matched_group 4 line |> int_of_string in + Some + ( filepath_of_path filepath, + { + start_pos = {line = line_number; col = start_col}; + end_pos = {line = line_number; col = end_col}; + } ) + else if Str.string_match multi_line_re line 0 then + let filepath = Str.matched_group 1 line in + let start_line = Str.matched_group 2 line |> int_of_string in + let end_line = Str.matched_group 3 line |> int_of_string in + let start_col = Str.matched_group 4 line |> int_of_string in + let end_col = Str.matched_group 5 line |> int_of_string in + Some + ( filepath_of_path filepath, + { + start_pos = {line = start_line; col = start_col}; + end_pos = {line = end_line; col = end_col}; + } ) + else None + + let parse_location line = + match parse_path_location line with + | Some location -> Some (Path_location, location) + | None -> ( + match parse_file_location line with + | Some location -> Some (File_location, location) + | None -> None) + + let is_location_line line = + match parse_location line with + | Some _ -> true + | None -> false + + let is_source_code_line line = + (* Matches lines like: + 1 │ let a = 1 + 2 │ let b = "hi" + 11 | ......Todos { + 46 ┆ module Input = { + + Unnumbered OCaml gutter continuation lines are handled by + [message_from_lines] only after a numbered source line has started an + excerpt. A diagnostic message can itself start with [|], for example + missing pattern-match cases. + *) + let rescript_re = Str.regexp "^[ \t]*[0-9]+[ \t]*│" in + let rescript_rei_re = Str.regexp "^[ \t]*[0-9]+[ \t]*┆" in + let ocaml_re = Str.regexp "^[ \t]*[0-9]+[ \t]*|" in + Str.string_match rescript_re line 0 + || Str.string_match rescript_rei_re line 0 + || Str.string_match ocaml_re line 0 + + let is_source_continuation_line line = + Str.string_match (Str.regexp "^[ \t]*|") line 0 + + let is_source_excerpt_line line = + is_source_code_line line || is_source_continuation_line line + + let trim_empty_edges lines = + let rec drop_start = function + | [] -> [] + | x :: xs when is_blank x -> drop_start xs + | xs -> xs + in + + let rec drop_end xs = + match List.rev xs with + | [] -> [] + | x :: rest when is_blank x -> drop_end (List.rev rest) + | _ -> xs + in + + lines |> drop_start |> drop_end + + let find_title_index lines loc_index = + let rec loop i = + if i < 0 then None + else + let line = lines.(i) in + let trimmed = String.trim line in + + if is_blank line || starts_with "#Start" trimmed then loop (i - 1) + else Some i + in + loop (loc_index - 1) + + let severity_from_message lines = + let rec loop = function + | [] -> None + | line :: rest -> ( + let content = String.trim line in + if is_blank content || is_source_excerpt_line content then loop rest + else + match content with + | other when String.starts_with ~prefix:"Warning " other -> + Some Lsp.Types.DiagnosticSeverity.Warning + | other when String.starts_with ~prefix:"Error" other -> + Some Lsp.Types.DiagnosticSeverity.Error + | _ -> None) + in + loop lines + + let is_diagnostic_message_start line = + let content = String.trim line in + String.starts_with ~prefix:"Warning " content + || String.starts_with ~prefix:"Error" content + + let kind_from_title title = + match title with + | "Syntax error!" -> Syntax_error + | "We've found a bug for you!" -> Common_error + | other when String.starts_with ~prefix:"Warning number" other -> Warning + | _ -> Unknow + + let kind_from_message lines = + let rec loop = function + | [] -> Unknow + | line :: rest -> + let content = String.trim line in + if is_blank content || is_source_excerpt_line content then loop rest + else if String.starts_with ~prefix:"Warning " content then Warning + else if String.starts_with ~prefix:"Error" content then Unknow + else loop rest + in + loop lines + + let message_from_lines lines = + let rec filter_source_lines in_source_excerpt acc = function + | [] -> List.rev acc + | line :: rest -> + let trimmed = String.trim line in + if + is_location_line line + || starts_with "#Done" trimmed + || starts_with "#Start" trimmed + then filter_source_lines false acc rest + else if is_source_code_line line then filter_source_lines true acc rest + else if in_source_excerpt then + if is_diagnostic_message_start line then + filter_source_lines false (line :: acc) rest + else if is_blank line then + filter_source_lines false (line :: acc) rest + else filter_source_lines true acc rest + else filter_source_lines false (line :: acc) rest + in + lines + |> filter_source_lines false [] + |> trim_empty_edges |> List.map String.trim |> String.concat "\n" + + let unique_preserve_order items = + let rec loop seen acc = function + | [] -> List.rev acc + | item :: rest -> + if List.mem item seen then loop seen acc rest + else loop (item :: seen) (item :: acc) rest + in + loop [] [] items + + let collect_matches re group line = + let rec loop start acc = + try + ignore (Str.search_forward re line start); + let matched = Str.matched_group group line in + loop (Str.match_end ()) (matched :: acc) + with Not_found -> List.rev acc + in + loop 0 [] + + let source_path_from_artifact_path path = + if ends_with ".cmj" path then + String.sub path 0 (String.length path - 4) ^ ".res" + else path + + let parse_dependency_cycle_paths message_lines = + let paren_source_path_re = + Str.regexp "(\\([^()]+\\.\\(res\\|resi\\|re\\|rei\\)\\))" + in + let artifact_path_re = Str.regexp "\\([^ ]+\\.cmj\\)" in + let source_paths = + message_lines |> List.concat_map (collect_matches paren_source_path_re 1) + in + match source_paths with + | _ :: _ -> unique_preserve_order source_paths + | [] -> + message_lines + |> List.concat_map (collect_matches artifact_path_re 1) + |> List.map source_path_from_artifact_path + |> unique_preserve_order + + let parse_dependency_cycle_entries lines len = + let rec collect_until_done i acc = + if i >= len then (List.rev acc, i) + else + let trimmed = String.trim lines.(i) in + if starts_with "#Done" trimmed then (List.rev acc, i) + else collect_until_done (i + 1) (lines.(i) :: acc) + in + let rec loop i acc = + if i >= len then List.rev acc + else + let trimmed = String.trim lines.(i) in + if starts_with "Can't continue... Found a circular dependency" trimmed + then + let message_lines, next_i = collect_until_done i [] in + let message = + message_lines |> trim_empty_edges |> List.map String.trim + |> String.concat "\n" + in + let paths = parse_dependency_cycle_paths message_lines in + let entries = + paths + |> List.map (fun filepath -> + ( filepath_of_path filepath, + Circular_dependency, + zero_range, + Lsp.Types.DiagnosticSeverity.Error, + message )) + in + loop (next_i + 1) (List.rev_append entries acc) + else if starts_with "FAILED: dependency cycle:" trimmed then + let message = trimmed in + let paths = parse_dependency_cycle_paths [trimmed] in + let entries = + paths + |> List.map (fun filepath -> + ( filepath_of_path filepath, + Circular_dependency, + zero_range, + Lsp.Types.DiagnosticSeverity.Error, + message )) + in + loop (i + 1) (List.rev_append entries acc) + else loop (i + 1) acc + in + loop 0 [] + + let make_diagnostic ?severity ~range ~message () = + (* -1 because lsp line and col is 0 based *) + let minus_one v = if v == 0 then v else v - 1 in + Lsp.Types.Diagnostic.create ?severity ~source:"ReScript" + ~range: + (Lsp.Types.Range.create + ~start: + (Lsp.Types.Position.create + ~line:(range.start_pos.line |> minus_one) + ~character:(range.start_pos.col |> minus_one)) + ~end_: + (Lsp.Types.Position.create + ~line:(range.end_pos.line |> minus_one) + ~character:range.end_pos.col)) + ~message:(`String message) () + + let parse_log_content (content : string) = + let lines = split_lines content in + let len = Array.length lines in + + let diagnostics = + let rec loop i acc = + if i >= len then List.rev acc + else + match parse_location lines.(i) with + | Some (location_format, location) -> + let title_index = + match location_format with + | Path_location -> find_title_index lines i + | File_location -> None + in + loop (i + 1) ((i, title_index, location_format, location) :: acc) + | None -> loop (i + 1) acc + in + loop 0 [] + in + + let rec build entries = + match entries with + | [] -> [] + | (loc_index, title_index, location_format, (filepath, range)) :: rest -> + let next_boundary = + match rest with + | (next_loc_index, next_title_index, next_location_format, _) :: _ + -> ( + match next_location_format with + | File_location -> next_loc_index + | Path_location -> ( + match next_title_index with + | Some i -> i + | None -> next_loc_index)) + | [] -> len + in + + let message_start = + match title_index with + | Some i -> i + 1 + | None -> loc_index + 1 + in + + let raw_message_lines = + let rec collect i acc = + if i >= next_boundary then List.rev acc + else collect (i + 1) (lines.(i) :: acc) + in + collect message_start [] + in + + let severity = + match location_format with + | File_location -> severity_from_message raw_message_lines + | Path_location -> ( + match title_index with + | Some i -> ( + let content = String.trim lines.(i) in + match content with + | "Syntax error!" | "We've found a bug for you!" -> + Some Lsp.Types.DiagnosticSeverity.Error + | other when String.starts_with ~prefix:"Warning number" other -> + Some Lsp.Types.DiagnosticSeverity.Warning + | _ -> None) + | None -> None) + in + + let entry = + match location_format with + | File_location -> kind_from_message raw_message_lines + | Path_location -> ( + match title_index with + | Some i -> kind_from_title (String.trim lines.(i)) + | None -> kind_from_message raw_message_lines) + in + + let message = message_from_lines raw_message_lines in + + let diagnostic = make_diagnostic ?severity ~range ~message () in + (filepath, {entry; diagnostic}) :: build rest + in + + let dependency_cycle_diagnostics = + parse_dependency_cycle_entries lines len + |> List.map (fun (filepath, entry, range, severity, message) -> + let diagnostic = make_diagnostic ~severity ~range ~message () in + (filepath, {entry; diagnostic})) + in + + build diagnostics @ dependency_cycle_diagnostics +end + +(* TODO: Add more tests (fatal error), gentype warning, configured as error, The implementation `does not match the interface *) +let%expect_test "parse log" = + let print_logs logs = + logs + |> List.iter (fun ((path : Parse.path), (entry : Parse.diagnostic_entry)) -> + let path = + match path with + | Parse.Relative_path p -> Printf.sprintf "Relative_path(%s)" p + | Full_path p -> Printf.sprintf "Full_path(%s)" p + in + print_endline + ((match entry.entry with + | Syntax_error -> "Syntax_error" + | Warning -> "Warning" + | Unknow -> "Unknow" + | Circular_dependency -> "Circular_dependency" + | Common_error -> "Common_error") + ^ " - " ^ path); + Lsp.Types.Diagnostic.yojson_of_t entry.diagnostic + |> Yojson.Safe.pretty_to_string |> print_endline; + print_newline ()) + in + let example_log_1 = + {| + #Start(1600519680823) + + Syntax error! + /Users/chenglou/github/reason-react/src/test.res:1:8-2:3 + + 1 │ let a = + 2 │ let b = + 3 │ + + This let-binding misses an expression + + + Warning number 8 + /Users/chenglou/github/reason-react/src/test.res:3:5-8 + + 1 │ let a = j`😀` + 2 │ let b = `😀` + 3 │ let None = None + 4 │ let bla: int = " + 5 │ hi + + You forgot to handle a possible case here, for example: + Some _ + + + We've found a bug for you! + /Users/chenglou/github/reason-react/src/test.res:3:9 + + 1 │ let a = 1 + 2 │ let b = "hi" + 3 │ let a = b + 1 + + This has type: string + Somewhere wanted: int + + #Done(1600519680836) + |} + in + + Parse.parse_log_content example_log_1 |> print_logs; + [%expect + {| + Syntax_error - Full_path(/Users/chenglou/github/reason-react/src/test.res) + { + "message": "This let-binding misses an expression", + "range": { + "end": { "character": 3, "line": 1 }, + "start": { "character": 7, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + + Warning - Full_path(/Users/chenglou/github/reason-react/src/test.res) + { + "message": "You forgot to handle a possible case here, for example:\nSome _", + "range": { + "end": { "character": 8, "line": 2 }, + "start": { "character": 4, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Common_error - Full_path(/Users/chenglou/github/reason-react/src/test.res) + { + "message": "This has type: string\nSomewhere wanted: int", + "range": { + "end": { "character": 9, "line": 2 }, + "start": { "character": 8, "line": 2 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_2 = + {| + #Start(1780532423603) + #Done(1780532423840) + + |} + in + + Parse.parse_log_content example_log_2 |> print_logs; + [%expect {| |}]; + + (* https://github.com/rescript-lang/rescript-vscode/issues/386#issuecomment-1221093517 *) + let example_log_3 = + {| + #Start(1660943070627) + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Fragments.res", lines 11-13, characters 6-7: + 11 | ......Todos { + | ...TodoItem + | } + 13 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/PromiseChaining.res", lines 17-21, characters 6-7: + 17 | ......os: allTodos { + | id + | text + | completed + | } + 21 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/ClientBasics.res", lines 18-22, characters 6-7: + 18 | ......os: allTodos { + | id + | text + | completed + | } + 22 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/docs/Docs.res", lines 7-11, characters 6-7: + 7 | ......os: allTodos { + | id + | text + | completed + | } + 11 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Query_Fragments.res", lines 6-9, characters 6-7: + 6 | ......os: allTodos { + | # This references the TodoItem fragment definition module above! + | ...TodoItem + | } + 9 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Mutation.res", lines 18-22, characters 6-7: + 18 | ......os: allTodos { + | id + | completed + | text + | } + 22 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Lazy.res", lines 3-7, characters 6-7: + 3 | ......os: allTodos { + | id + | text + | completed + | } + 7 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_OverlySimple.res", lines 3-7, characters 4-5: + 3 | ....os: allTodos { + | id + | text + | completed + | } + 7 | . + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_SubscribeToMore.res", lines 5-9, characters 6-7: + 5 | ......os: allTodos { + | id + | completed + | text + | } + 9 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + File "/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Typical.res", lines 4-8, characters 6-7: + 4 | ......os: allTodos { + | id + | text + | completed + | } + 8 | ... + Warning 22 [preprocessor]: Field "allTodos" has been deprecated. Reason: null + #Done(1660943070848) + |} + in + + Parse.parse_log_content example_log_3 |> print_logs; + [%expect + {| + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Fragments.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 12 }, + "start": { "character": 5, "line": 10 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/PromiseChaining.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 20 }, + "start": { "character": 5, "line": 16 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/clientUsage/ClientBasics.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 21 }, + "start": { "character": 5, "line": 17 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/docs/Docs.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 10 }, + "start": { "character": 5, "line": 6 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/fragmentsUsage/Query_Fragments.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 8 }, + "start": { "character": 5, "line": 5 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Mutation.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 21 }, + "start": { "character": 5, "line": 17 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Lazy.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 6 }, + "start": { "character": 5, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_OverlySimple.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 5, "line": 6 }, + "start": { "character": 3, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_SubscribeToMore.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 8 }, + "start": { "character": 5, "line": 4 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/rescript-apollo-client/EXAMPLES/src/hooksUsage/Query_Typical.res) + { + "message": "Warning 22 [preprocessor]: Field \"allTodos\" has been deprecated. Reason: null", + "range": { + "end": { "character": 7, "line": 7 }, + "start": { "character": 5, "line": 3 } + }, + "severity": 2, + "source": "ReScript" + } + |}]; + + (* https://github.com/rescript-lang/rescript-vscode/issues/86#issuecomment-786186698 *) + let example_log_4 = + {|#Start(1614285167013) + + Warning number 33 + /home/misha/projects/productionmason/web/auth/src/ErrorHandlingMiddleware.res:1:1-15 + + 1 │ open CommonBase + 2 │ + 3 │ external jsExnToExpressError: Js.Exn.t => Express.Error.t = "%identity" + + unused open CommonBase. + + + Warning number 27 + /home/misha/projects/productionmason/web/auth/src/config/Config.res:10:22-27 + + 8 │ external stringifyAnyWithSpace: ('a, @bs.as(json`null`) _, int) => str + ing = "stringify" + 9 │ + 10 │ let validateConfig = config => { + 11 │ let googleApplicationCredentialsPath = + 12 │ NodeJs.Process.env(NodeJs.Process.process)->Js.Dict.get("GOOGLE_AP + PLICATION_CREDENTIALS") + + unused variable config. + + + Warning number 34 + /home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re:48:5-26 + + 46 ┆ module Input = { + 47 ┆ [@decco] + 48 ┆ type t = Request.input; + 49 ┆ }; + 50 ┆ + + unused type t. + + + Warning number 32 + /home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re + + unused value t_encode. + + + We've found a bug for you! + /home/misha/projects/productionmason/web/auth/tests/Auth_Test.res:224:45 + + 222 ┆ ->AsyncResult.mapOk(x => { + 223 ┆ expect(x.data.users->Array.length)->toBeGreaterThan(0) + 224 ┆ expect(x.data.users->Array.getExn(0).last_name)->toBe(Some("Glenliv + et")) + 225 ┆ Ok() + 226 ┆ }) + + This has type: int + Somewhere wanted: array<'a> + + #Done(1614285167075)|} + in + + Parse.parse_log_content example_log_4 |> print_logs; + [%expect + {| + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/ErrorHandlingMiddleware.res) + { + "message": "unused open CommonBase.", + "range": { + "end": { "character": 15, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/config/Config.res) + { + "message": "unused variable config.", + "range": { + "end": { "character": 27, "line": 9 }, + "start": { "character": 21, "line": 9 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re) + { + "message": "unused type t.", + "range": { + "end": { "character": 26, "line": 47 }, + "start": { "character": 4, "line": 47 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/misha/projects/productionmason/web/auth/src/express-handler/ExpressHandler.re) + { + "message": "unused value t_encode.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 2, + "source": "ReScript" + } + + Common_error - Full_path(/home/misha/projects/productionmason/web/auth/tests/Auth_Test.res) + { + "message": "This has type: int\nSomewhere wanted: array<'a>", + "range": { + "end": { "character": 45, "line": 223 }, + "start": { "character": 44, "line": 223 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_5 = + {|#Start(1780595107359) + + Can't continue... Found a circular dependency in your code: + Demo (src/Demo.res) + → Other (src/Other.res) + → Demo (src/Demo.res) + Possible solutions: + - Extract shared code into a new module both depend on. + #Done(1780595107364) + |} + in + + Parse.parse_log_content example_log_5 |> print_logs; + [%expect + {| + Circular_dependency - Relative_path(src/Demo.res) + { + "message": "Can't continue... Found a circular dependency in your code:\nDemo (src/Demo.res)\n→ Other (src/Other.res)\n→ Demo (src/Demo.res)\nPossible solutions:\n- Extract shared code into a new module both depend on.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + + Circular_dependency - Relative_path(src/Other.res) + { + "message": "Can't continue... Found a circular dependency in your code:\nDemo (src/Demo.res)\n→ Other (src/Other.res)\n→ Demo (src/Demo.res)\nPossible solutions:\n- Extract shared code into a new module both depend on.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_6 = + {|#Start(1780595245481) + FAILED: dependency cycle: src/Demo.cmj -> src/Other.cmj -> src/Demo.cmj. + #Done(1780595245488)|} + in + + Parse.parse_log_content example_log_6 |> print_logs; + [%expect + {| + Circular_dependency - Relative_path(src/Demo.res) + { + "message": "FAILED: dependency cycle: src/Demo.cmj -> src/Other.cmj -> src/Demo.cmj.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + + Circular_dependency - Relative_path(src/Other.res) + { + "message": "FAILED: dependency cycle: src/Demo.cmj -> src/Other.cmj -> src/Demo.cmj.", + "range": { + "end": { "character": 0, "line": 0 }, + "start": { "character": 0, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_7 = + {|#Start(1780595410580) + + We've found a bug for you! + /tmp/my-rescript-app/src/Demo.res:1:9-15 + + 1 │ let a = Other.a + 2 │ + + The value a can't be found in Other + + FAILED: cannot make progress due to previous errors. + #Done(1780595410597)|} + in + + Parse.parse_log_content example_log_7 |> print_logs; + [%expect + {| + Common_error - Full_path(/tmp/my-rescript-app/src/Demo.res) + { + "message": "The value a can't be found in Other\n\nFAILED: cannot make progress due to previous errors.", + "range": { + "end": { "character": 15, "line": 0 }, + "start": { "character": 8, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_8 = + {|#Start(1780603624843) + Error in lsp-test: + + Syntax error! + /home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res:1:41-2:0 + + 1 │ let empty = arr => Array.length(arr) === + 2 │ + + Did you forget to write an expression here? + + #Done(1780603624849)|} + in + Parse.parse_log_content example_log_8 |> print_logs; + [%expect + {| + Syntax_error - Full_path(/home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res) + { + "message": "Did you forget to write an expression here?", + "range": { + "end": { "character": 0, "line": 1 }, + "start": { "character": 40, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_9 = + {|#Start(1780630901455) + + We've found a bug for you! + /home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res:1:41-43 + + 1 │ let empty = arr => Array.length(arr) == "2"; + 2 │ + + This has type: string + But it's being compared to something of type: int + + You can only compare things of the same type. + + You can convert string to int with Int.fromString. + + #Done(1780630901468)|} + in + + Parse.parse_log_content example_log_9 |> print_logs; + [%expect + {| + Common_error - Full_path(/home/pedro/Desktop/projects/lsp-test/src/ArrayUtils.res) + { + "message": "This has type: string\nBut it's being compared to something of type: int\n\nYou can only compare things of the same type.\n\nYou can convert string to int with Int.fromString.", + "range": { + "end": { "character": 43, "line": 0 }, + "start": { "character": 40, "line": 0 } + }, + "severity": 1, + "source": "ReScript" + } + |}]; + + let example_log_10 = + {|#Start(1781383030890) + + Warning number 8 (configured as error) + /home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res:6:3-9:3 + + 4 │ + 5 │ let f = (a: t) => { + 6 │ switch a { + 7 │ | A => () + 8 │ | B => () + 9 │ } + 10 │ } + 11 │ + + You forgot to handle a possible case here, for example: + | C + + + Warning number 37 + /home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res:3:1-18 + + 1 │ open ReactRouter.Routes + 2 │ + 3 │ type t = A | B | C + 4 │ + 5 │ let f = (a: t) => { + + constructor A is never used to build values. + (However, this constructor appears in patterns.) + + + Warning number 37 + /home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res:3:1-18 + + 1 │ open ReactRouter.Routes + 2 │ + 3 │ type t = A | B | C + 4 │ + 5 │ let f = (a: t) => { + + constructor B is never used to build values. + (However, this constructor appears in patterns.) + + + Warning number 37 + /home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res:3:1-18 + + 1 │ open ReactRouter.Routes + 2 │ + 3 │ type t = A | B | C + 4 │ + 5 │ let f = (a: t) => { + + unused constructor C. + + + Warning number 32 + /home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res:5:5 + + 3 │ type t = A | B | C + 4 │ + 5 │ let f = (a: t) => { + 6 │ switch a { + 7 │ | A => () + + unused value f. + + #Done(1781383030936)|} + in + Parse.parse_log_content example_log_10 |> print_logs; + [%expect + {| + Warning - Full_path(/home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res) + { + "message": "You forgot to handle a possible case here, for example:\n| C", + "range": { + "end": { "character": 3, "line": 8 }, + "start": { "character": 2, "line": 5 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res) + { + "message": "constructor A is never used to build values.\n(However, this constructor appears in patterns.)", + "range": { + "end": { "character": 18, "line": 2 }, + "start": { "character": 0, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res) + { + "message": "constructor B is never used to build values.\n(However, this constructor appears in patterns.)", + "range": { + "end": { "character": 18, "line": 2 }, + "start": { "character": 0, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res) + { + "message": "unused constructor C.", + "range": { + "end": { "character": 18, "line": 2 }, + "start": { "character": 0, "line": 2 } + }, + "severity": 2, + "source": "ReScript" + } + + Warning - Full_path(/home/pedro/Desktop/projects/rescript-lang.org/apps/docs/app/DocsRoutes.res) + { + "message": "unused value f.", + "range": { + "end": { "character": 5, "line": 4 }, + "start": { "character": 4, "line": 4 } + }, + "severity": 2, + "source": "ReScript" + } + |}] diff --git a/lsp/src/configuration.ml b/lsp/src/configuration.ml new file mode 100644 index 00000000000..2ef810483e4 --- /dev/null +++ b/lsp/src/configuration.ml @@ -0,0 +1,35 @@ +type hover = { + support_markdown_links: bool; [@key "supportMarkdownLinks"] [@default false] +} +[@@deriving yojson] + +type inlay_hints = { + enable: bool; [@default false] + max_length: int option; [@key "maxLength"] [@default Some 25] +} +[@@deriving yojson] + +type signature_help = { + enable: bool; [@default true] + for_constructor_payloads: bool; [@key "forConstructorPayloads"] [@default true] +} +[@@deriving yojson] + +type t = { + hover: hover; [@default {support_markdown_links = false}] + code_lens: bool; [@key "codeLens"] [@default false] + inlay_hints: inlay_hints; + [@key "inlayHints"] [@default {enable = false; max_length = Some 25}] + signature_help: signature_help; + [@key "signatureHelp"] + [@default {enable = true; for_constructor_payloads = true}] +} +[@@deriving yojson] + +let default = + { + hover = {support_markdown_links = false}; + code_lens = false; + inlay_hints = {enable = false; max_length = Some 25}; + signature_help = {enable = true; for_constructor_payloads = true}; + } diff --git a/lsp/src/constants.ml b/lsp/src/constants.ml new file mode 100644 index 00000000000..1e3bda18a0f --- /dev/null +++ b/lsp/src/constants.ml @@ -0,0 +1,14 @@ +let ( /+ ) = Filename.concat + +let rescript_json = "rescript.json" +let bsconfig_json = "bsconfig.json" +let compiler_dir_partial_path = "lib" /+ "bs" +let compiler_ocaml_dir_partial_path = "lib" /+ "ocaml" +let compiler_log = ".compiler.log" +let sources_dirs = ".sourcedirs.json" +let compiler_log_partial_path = compiler_dir_partial_path /+ compiler_log +let compiler_info_partial_path = + compiler_dir_partial_path /+ "compiler-info.json" +let build_ninja_partial_path = compiler_dir_partial_path /+ "build.ninja" +let rewatch_lock_partial_path = "lib" /+ "rewatch.lock" +let rescript_lock_partial_path = "lib" /+ "rescript.lock" diff --git a/lsp/src/custom_requests.ml b/lsp/src/custom_requests.ml new file mode 100644 index 00000000000..53ed6d959b3 --- /dev/null +++ b/lsp/src/custom_requests.ml @@ -0,0 +1,130 @@ +open Lsp + +let make_error ?(code = Jsonrpc.Response.Error.Code.InternalError) message = + Jsonrpc.Response.Error.make ~message ~code () + +module Open_compiled_file = struct + let meth = "textDocument/openCompiled" + let create ~(uri : Uri.t) ~(state : State.t) = + let compiled_uri = + Helpers.get_compiled_file ~uri + ~compiler_config:(State.compiler_config state) + ~fs:state.fs + ~workspace_root:(State.workspace_root state) + in + match compiled_uri with + | Some uri -> Ok uri + | None -> Error ("Failed to get compiled file for " ^ Uri.to_path uri) + + (* Custom request to open compiled file + + Request params: + { + "uri": Uri.t + } + + Response: + { + "uri": Uri.t + } + *) + let on_request ~(params : Jsonrpc.Structured.t option) ~(state : State.t) = + let r = + match params with + | Some (`Assoc fields) -> ( + match List.assoc_opt "uri" fields with + | Some (`String uri) -> ( + let uri = Uri.of_string uri in + match create ~uri ~state with + | Ok uri -> Ok (`Assoc [("uri", `String (uri |> Uri.to_string))]) + | Error message -> + Error (make_error ?code:(Some InternalError) message)) + | _ -> + Error + (make_error ?code:(Some InvalidParams) + "Invalid params for request textDocument/createInterfaceFile")) + | _ -> + Error + (make_error ?code:(Some InvalidParams) + "Invalid params for request textDocument/createInterfaceFile") + in + r +end + +module Create_interface_file = struct + let meth = "textDocument/createInterface" + + let create ~uri ~cmi_uri ~(state : State.t) = + match Document.kind uri with + | Res -> ( + match + Analysis.Create_interface.command + ~source:(Document_store.get ~uri state.store).text + ~cmi_file:(cmi_uri |> Uri.to_path) + with + | Ok content -> + let resi_file = Uri.to_path uri ^ "i" in + let () = + Fs.save ~append:false ~create:(`Or_truncate 0o644) ~fs:state.fs + resi_file content + in + Ok (Uri.of_path resi_file) + | Error e -> Error e) + | _ -> + Error + (Printf.sprintf + "Invalid file to create interface for %s. Expected a .res file" + (Uri.to_string uri)) + + (* Custom request to create a interface file. + + Request params: + { + "uri": Uri.t + } + + Response: + { + "uri": Uri.t + } + *) + let on_request ~(params : Jsonrpc.Structured.t option) ~(state : State.t) = + let r = + match params with + | Some (`Assoc fields) -> ( + match List.assoc_opt "uri" fields with + | Some (`String uri) -> + let uri = Uri.of_string uri in + let cmi_file = + Helpers.get_cmi_file ~uri ~fs:state.fs + ~compiler_config:(State.compiler_config state) + ~workspace_root:(State.workspace_root state) + in + let result = + match cmi_file with + | Some cmi_file -> + let response = + match create ~uri ~cmi_uri:(Uri.of_path cmi_file) ~state with + | Ok uri -> + Ok (`Assoc [("uri", `String (uri |> Uri.to_string))]) + | Error message -> + Error (make_error ?code:(Some InternalError) message) + in + response + | None -> + Error + (make_error ?code:(Some InternalError) + "Failed to find cmi file to create interface file") + in + result + | _ -> + Error + (make_error ?code:(Some InvalidParams) + "Invalid params for request textDocument/createInterfaceFile")) + | _ -> + Error + (make_error ?code:(Some InvalidParams) + "Invalid params for request textDocument/createInterfaceFile") + in + r +end diff --git a/lsp/src/diagnostics.ml b/lsp/src/diagnostics.ml new file mode 100644 index 00000000000..a0ee8975bc9 --- /dev/null +++ b/lsp/src/diagnostics.ml @@ -0,0 +1,143 @@ +open Lsp +open Types + +module Uri_map = Map.Make (Uri) + +type diagnostics = Diagnostic.t list Uri_map.t + +type t = {diagnostics: diagnostics; send: PublishDiagnosticsParams.t -> unit} + +let empty () = Uri_map.empty + +let create ~diagnostics ~send = {diagnostics; send} + +let from_uri ~uri (d : Diagnostic.t list) = Uri_map.add uri d (empty ()) + +(* Compiler log diagnostics are a full snapshot of the latest build output. + Overwrite the previous compiler log diagnostics so files that disappeared + from the new log receive an empty diagnostic list and stale errors are + cleared in the client. *) +let overwrite ~(new_diagnostics : diagnostics) t = + let diagnostics = + Uri_map.merge + (fun _ existing incoming -> + match (existing, incoming) with + | None, None -> Some [] + | Some _, None -> Some [] + | None, Some diagnostics -> Some diagnostics + | Some _, Some diagnostics -> Some diagnostics) + t.diagnostics new_diagnostics + in + {t with diagnostics} + +let append ~(new_diagnostics : diagnostics) t = + let diagnostics = + Uri_map.merge + (fun _ existing incoming -> + match (existing, incoming) with + | None, None -> Some [] + | Some diagnostics, None -> Some diagnostics + | None, Some diagnostics -> Some diagnostics + | Some a, Some b -> Some (a @ b)) + t.diagnostics new_diagnostics + in + {t with diagnostics} + +let send t = + Uri_map.iter + (fun uri diagnostics -> + t.send (PublishDiagnosticsParams.create ~uri ~diagnostics ())) + t.diagnostics + +(* Convert parsed compiler-log entries into LSP diagnostics grouped by document URI. + Compiler logs may report paths either relative to the workspace root or as + absolute paths, so this function normalizes each entry into a DocumentUri + before publishing. + Syntax errors are skipped here because they are produced from the current + in-memory document text during TextDocumentDidChange notification. + Compiler log diagnostics are used for build output such as type errors, + warnings, and circular dependencies. *) +let to_lsp_format (workspace_root : DocumentUri.t) + (doc_store : Document_store.t) diagnostics = + let workspace_root_path = workspace_root |> DocumentUri.to_path in + + let diagnostics_sanitized = + diagnostics + |> List.filter_map + (fun + (filepath, (diagnostic_entry : Compiler_log.Parse.diagnostic_entry)) + -> + let uri = + match filepath with + | Compiler_log.Parse.Relative_path p -> + DocumentUri.of_path (Filename.concat workspace_root_path p) + | Full_path p -> DocumentUri.of_path p + in + + match diagnostic_entry.entry with + | Syntax_error -> None + | Circular_dependency -> + (* Circular dependency diagnostics are special-cased because the compiler log + does not point at a precise source range. When the document is open, we expand + the diagnostic range to cover the whole document so the editor can display a + file-level diagnostic. If the document is not open, we keep the range parsed + from the compiler log [(0,0), (0,0)].*) + let range = + match Document_store.get_opt ~uri doc_store with + | None -> diagnostic_entry.diagnostic.range + | Some {text} -> + (* TODO: Revisit this *) + let lines = String.split_on_char '\n' text in + + let end_line, end_character = + match List.rev lines with + | [] -> (0, String.length "let a" - 1) + | last_line :: rest -> + let line_count = List.length rest in + (line_count - 1, String.length last_line - 1) + in + Range.create + ~start:(Position.create ~line:0 ~character:0) + ~end_: + (Position.create ~line:end_line ~character:end_character) + in + let diagnostic = {diagnostic_entry.diagnostic with range} in + Some (uri, diagnostic) + | Warning | Common_error | Unknow -> + Some (uri, diagnostic_entry.diagnostic)) + in + + diagnostics_sanitized + |> List.fold_left + (fun acc (uri, diagnostic) -> + Uri_map.update uri + (function + | None -> Some [diagnostic] + | Some diagnostics -> Some (diagnostic :: diagnostics)) + acc) + Uri_map.empty + +let collect_diagnostics_from_log_using_source_dirs workspace_root fs = + let ( /+ ) = Filename.concat in + let workspace_root_path = workspace_root |> Lsp.Types.DocumentUri.to_path in + let path = + workspace_root_path /+ Constants.compiler_dir_partial_path + /+ Constants.sources_dirs + in + let build_roots = Source_dirs.get_build_roots_from_file ~fs path in + let diagnostics = + match build_roots with + | Some build_roots -> + build_roots + |> List.filter_map (fun build_root -> + let compiler_log_path = + workspace_root_path /+ build_root /+ Constants.compiler_log + in + match Fs.load ~fs compiler_log_path with + | Some content -> + Some (Compiler_log.Parse.parse_log_content content) + | None -> None) + |> List.flatten + | None -> [] + in + diagnostics diff --git a/lsp/src/document.ml b/lsp/src/document.ml new file mode 100644 index 00000000000..8497f82b6fc --- /dev/null +++ b/lsp/src/document.ml @@ -0,0 +1,17 @@ +type kind = Analysis.Files.classified_file +let kind uri = + match Filename.extension (Lsp.Types.DocumentUri.to_string uri) with + | ".res" -> Analysis.Files.Res + | ".resi" -> Analysis.Files.Resi + | other -> + Jsonrpc.Response.Error.raise + (Jsonrpc.Response.Error.make ~code:InvalidRequest + ~message:"unsupported file extension" + ~data:(`Assoc [("extension", `String other)]) + ()) + +let to_string (kind : kind) = + match kind with + | Res -> "res" + | Resi -> "resi" + | Other -> assert false diff --git a/lsp/src/document_store.ml b/lsp/src/document_store.ml new file mode 100644 index 00000000000..68badd7979d --- /dev/null +++ b/lsp/src/document_store.ml @@ -0,0 +1,50 @@ +type document = {text: string; version: int} + +type t = {documents: (Lsp.Uri.t, document) Hashtbl.t} + +let create () = {documents = Hashtbl.create 25} + +let raise ~message = + Jsonrpc.Response.Error.raise + (Jsonrpc.Response.Error.make ~code:InternalError ~message ()) + +let add t ~uri ~text ~version = + (match Hashtbl.mem t.documents uri with + | false -> Hashtbl.add t.documents uri {text; version} + | true -> + raise + ~message: + (Printf.sprintf "Document store already has %s to open" + (Lsp.Uri.to_string uri))); + t + +let update t ~uri ~text ~version = + (match Hashtbl.find_opt t.documents uri with + | None -> + raise + ~message: + (Printf.sprintf "Document store not found %s to update" + (Lsp.Uri.to_string uri)) + | Some _ -> Hashtbl.replace t.documents uri {text; version}); + t + +let remove t ~uri = + (match Hashtbl.mem t.documents uri with + | true -> Hashtbl.remove t.documents uri + | false -> + raise + ~message: + (Printf.sprintf "Document store not found %s to remove" + (Lsp.Uri.to_string uri))); + t + +let get_opt t ~uri = Hashtbl.find_opt t.documents uri + +let get t ~uri = + match get_opt t ~uri with + | Some doc -> doc + | None -> + raise + ~message: + (Printf.sprintf "Document store not found %s to get" + (Lsp.Uri.to_string uri)) diff --git a/lsp/src/dune b/lsp/src/dune new file mode 100644 index 00000000000..f270aab36b0 --- /dev/null +++ b/lsp/src/dune @@ -0,0 +1,8 @@ +(library + (name rescript_language_server) + (libraries lsp eio analysis str ppx_deriving_yojson.runtime) + (inline_tests) + (preprocess + (pps ppx_deriving_yojson ppx_expect)) + (flags + (:standard -w +a-4-9-30-40-41-42-48-70))) diff --git a/lsp/src/execute_commands.ml b/lsp/src/execute_commands.ml new file mode 100644 index 00000000000..acd04f20b60 --- /dev/null +++ b/lsp/src/execute_commands.ml @@ -0,0 +1,4 @@ +let create_interface = "rescript/createInterface" +let open_compiled = "rescript/openCompiled" +let switch_implementation_interface = "rescript/switchImplementationInterface" +let dump_server_state = "rescript/dumpServerState" diff --git a/lsp/src/fs.ml b/lsp/src/fs.ml new file mode 100644 index 00000000000..fda93591bf0 --- /dev/null +++ b/lsp/src/fs.ml @@ -0,0 +1,53 @@ +type fs = Eio.Fs.dir_ty Eio.Path.t + +let append = Eio.Path.( / ) + +let to_eio_path ~(fs : fs) (path : string) = append fs path + +let protect f = + match f () with + | value -> Some value + | exception _ -> None + +let load ~fs path = protect (fun () -> Eio.Path.load (to_eio_path ~fs path)) + +let save ?append ~create ~fs path content = + Eio.Path.save ?append ~create (to_eio_path ~fs path) content + +let stat ?(follow = true) ~fs path = + protect (fun () -> Eio.Path.stat ~follow (to_eio_path ~fs path)) + +let kind ?(follow = true) ~fs path = + match protect (fun () -> Eio.Path.kind ~follow (to_eio_path ~fs path)) with + | Some `Not_found | None -> None + | Some kind -> Some kind + +let exists ?(follow = true) ~fs path = + match kind ~follow ~fs path with + | Some _ -> true + | None -> false + +let is_file ~fs path = + protect (fun () -> Eio.Path.is_file (to_eio_path ~fs path)) + +let is_directory ~fs path = + protect (fun () -> Eio.Path.is_directory (to_eio_path ~fs path)) + +let read_dir ~fs path = + protect (fun () -> Eio.Path.read_dir (to_eio_path ~fs path)) + +let mkdir ~perm ~fs path = + protect (fun () -> Eio.Path.mkdir ~perm (to_eio_path ~fs path)) + +let mkdirs ?exists_ok ~perm ~fs path = + protect (fun () -> Eio.Path.mkdirs ?exists_ok ~perm (to_eio_path ~fs path)) + +let read_link ~fs path = + protect (fun () -> Eio.Path.read_link (to_eio_path ~fs path)) + +let unlink ~fs path = protect (fun () -> Eio.Path.unlink (to_eio_path ~fs path)) + +let rmdir ~fs path = protect (fun () -> Eio.Path.rmdir (to_eio_path ~fs path)) + +let rmtree ?missing_ok ~fs path = + protect (fun () -> Eio.Path.rmtree ?missing_ok (to_eio_path ~fs path)) diff --git a/lsp/src/helpers.ml b/lsp/src/helpers.ml new file mode 100644 index 00000000000..00c683a36b1 --- /dev/null +++ b/lsp/src/helpers.ml @@ -0,0 +1,207 @@ +open Lsp +open Lsp.Types + +let workspace_root_uri_of_initialize_params (params : InitializeParams.t) = + match (params.workspaceFolders, params.rootUri, params.rootPath) with + | Some (Some workspace_folders), Some root_uri, None -> + let root = + match workspace_folders with + | [] -> root_uri + | ws :: _ -> ws.uri + in + root + | _, Some root_uri, _ -> root_uri + | _, _, Some (Some root_path) -> root_path |> Uri.of_path + | _ -> + failwith + ("Failed to find a root path. Initialize params received: " + ^ Yojson.Safe.pretty_to_string (InitializeParams.yojson_of_t params)) + +(* Return the most specific root from [entries] that contains [path]. + + Matching is done on path boundaries, so [/repo/packages/app] matches + [/repo/packages/app/src/A.res], but it does not match + [/repo/packages/application/src/A.res]. + + If multiple roots match, the longest root wins. This matters in monorepos + where a file can be under both the workspace root and a nested package root. + + Examples: + - [best_root_match ~path:"/repo/packages/app/src/A.res" + ["/repo"; "/repo/packages/app"]] + returns [Some "/repo/packages/app"]. + - [best_root_match ~path:"/repo/packages/application/src/A.res" + ["/repo/packages/app"]] + returns [None]. *) +let best_root_match ~path entries = + let path_matches_root ~path ~root = + let is_sep = function + | '/' | '\\' -> true + | _ -> false + in + let root_len = String.length root in + let path_len = String.length path in + root_len > 0 + && (path = root + || path_len > root_len + && String.starts_with ~prefix:root path + && (is_sep root.[root_len - 1] || is_sep path.[root_len])) + in + entries + |> List.fold_left + (fun best root -> + if path_matches_root ~path ~root then + match best with + | None -> Some root + | Some best_root -> + if String.length root > String.length best_root then Some root + else best + else best) + None + +let relative_to ~root path = + let root = if String.ends_with ~suffix:"/" root then root else root ^ "/" in + + if String.starts_with ~prefix:root path then + let root_len = String.length root in + String.sub path root_len (String.length path - root_len) + else path + +let to_camel_case (text : string) : string = + let len = String.length text in + let buffer = Buffer.create len in + + let is_separator = function + | ' ' | '\t' | '\n' | '\r' | '-' -> true + | _ -> false + in + + let rec loop i capitalize_next = + if i >= len then Buffer.contents buffer + else + let c = text.[i] in + + if is_separator c then loop (i + 1) true + else if capitalize_next then ( + Buffer.add_char buffer (Char.uppercase_ascii c); + loop (i + 1) false) + else ( + Buffer.add_char buffer c; + loop (i + 1) false) + in + + loop 0 true + +let get_cmi_file ~(uri : Uri.t) ~(compiler_config : Compiler_config.t) + ~(fs : Fs.fs) ~workspace_root = + let config_roots = + compiler_config |> Compiler_config.Uri_map.to_seq + |> Seq.map (fun (uri, config) -> (uri |> Uri.to_path, config)) + |> List.of_seq |> List.map fst + in + + let config = + match + config_roots |> best_root_match ~path:(workspace_root |> Uri.to_path) + with + | Some root -> + Compiler_config.Uri_map.find_opt (Uri.of_path root) compiler_config + | None -> None + in + match config with + | Some config -> + let namespace = + match config.namespace with + | Some (Namespace_bool true) -> config.name |> to_camel_case + | Some (Namespace_string name) -> name |> to_camel_case + | _ -> "" + in + let suffix_to_append = + if String.length namespace > 0 then "-" ^ namespace else "" + in + let path = Uri.to_path uri in + let resi_file = + match best_root_match ~path config_roots with + | Some package_root_path -> + let cmi_file = + let open Filename in + let ( /+ ) = concat in + let relative_path = relative_to ~root:package_root_path path in + let sources_dir = dirname relative_path in + let cmi = + let res_file = basename relative_path ^ suffix_to_append in + remove_extension res_file ^ ".cmi" + in + package_root_path /+ "lib" /+ "bs" /+ sources_dir /+ cmi + in + let result = + match Fs.exists ~follow:false ~fs cmi_file with + | true -> Some cmi_file + | false -> None + in + result + | None -> None + in + resi_file + | None -> None + +let get_compiled_file ~(uri : Uri.t) ~(compiler_config : Compiler_config.t) + ~(fs : Fs.fs) ~workspace_root = + let config_roots = + compiler_config |> Compiler_config.Uri_map.to_seq + |> Seq.map (fun (uri, config) -> (uri |> Uri.to_path, config)) + |> List.of_seq |> List.map fst + in + + let config = + match + config_roots |> best_root_match ~path:(workspace_root |> Uri.to_path) + with + | Some root -> + Compiler_config.Uri_map.find_opt (Uri.of_path root) compiler_config + | None -> None + in + match config with + | Some config -> + let suffix, js_folder, in_source = + Compiler_config.get_suffix_and_folder config + in + + let js_file_path = + let path = Uri.to_path uri in + + let file_path = + let open Filename in + let ( /+ ) = concat in + if in_source then + let filename = basename path in + let js_file = remove_extension filename ^ suffix in + Some (dirname path /+ js_file) + else + match best_root_match ~path config_roots with + | Some package_root_path -> + (* + Some example with sources + package_root_path: /home/pedro/Desktop/projects/rescript-lang.org/apps/guide + path: /home/pedro/Desktop/projects/rescript-lang.org/apps/guide/app/GuideHome.res + compiled js: /home/pedro/Desktop/projects/rescript-lang.org/apps/guide/lib/es6/app/GuideHome.jsx + *) + (* app/GuideHome.res *) + let relative_path = relative_to ~root:package_root_path path in + let sources_dir = dirname relative_path in + let js_file = + let res_file = basename relative_path in + remove_extension res_file ^ suffix + in + Some + (package_root_path /+ "lib" /+ js_folder /+ sources_dir /+ js_file) + | None -> None + in + match file_path with + | Some file_path when Fs.exists ~fs ~follow:false file_path -> + Some (file_path |> Uri.of_path) + | _ -> None + in + + js_file_path + | None -> None diff --git a/lsp/src/rescript_language_server.ml b/lsp/src/rescript_language_server.ml new file mode 100644 index 00000000000..63bce9f2c40 --- /dev/null +++ b/lsp/src/rescript_language_server.ml @@ -0,0 +1,808 @@ +open Lsp +open Types + +let initialization (_client_capabilities : ClientCapabilities.t) = + let textDocumentSync = + `TextDocumentSyncOptions + (TextDocumentSyncOptions.create ~openClose:true + ~change:TextDocumentSyncKind.Full ~willSave:false + ~save:(`SaveOptions (SaveOptions.create ~includeText:false ())) + ~willSaveWaitUntil:false ()) + in + let completionProvider = + CompletionOptions.create + ~triggerCharacters:["."; ">"; "@"; "~"; "\""; "="; "("] + ~resolveProvider:true () + in + let codeLensProvider = CodeLensOptions.create ~resolveProvider:false () in + let signatureHelpProvider = + SignatureHelpOptions.create ~triggerCharacters:["("] + ~retriggerCharacters:["="; ","] () + in + let inlayHintProvider = + `InlayHintOptions (InlayHintOptions.create ~resolveProvider:false ()) + in + let renameProvider = + `RenameOptions (RenameOptions.create ~prepareProvider:true ()) + in + let workspace = + let workspaceFolders = + WorkspaceFoldersServerCapabilities.create ~supported:true + ~changeNotifications:(`Bool true) () + in + ServerCapabilities.create_workspace ~workspaceFolders () + in + let semanticTokensProvider = + let legend = + SemanticTokensLegend.create ~tokenModifiers:[] + ~tokenTypes: + [ + "operator"; + "variable"; + "type"; + (* emit jsx-tag < and > in
as modifier *) + "modifier"; + "namespace"; + "enumMember"; + "property"; + (* emit jsxlowercase, div in
as interface *) + "interface"; + ] + in + let full = `Full (SemanticTokensOptions.create_full ~delta:false ()) in + `SemanticTokensOptions (SemanticTokensOptions.create ~legend ~full ()) + in + let codeActionProvider = + `CodeActionOptions (CodeActionOptions.create ~resolveProvider:false ()) + in + let executeCommandProvider = + ExecuteCommandOptions.create + ~commands: + [ + Execute_commands.create_interface; + Execute_commands.open_compiled; + Execute_commands.switch_implementation_interface; + Execute_commands.dump_server_state; + ] + () + in + + let capabilities = + ServerCapabilities.create ~textDocumentSync ~completionProvider + ~codeLensProvider ~hoverProvider:(`Bool true) ~signatureHelpProvider + ~renameProvider ~workspace ~semanticTokensProvider ~inlayHintProvider + ~definitionProvider:(`Bool true) ~typeDefinitionProvider:(`Bool true) + ~codeActionProvider ~documentSymbolProvider:(`Bool true) + ~referencesProvider:(`Bool true) ~documentFormattingProvider:(`Bool true) + ~executeCommandProvider () + in + let serverInfo = + let version = "2.0.0-aplha.1" in + InitializeResult.create_serverInfo ~name:"rescript-language-server" ~version + () + in + InitializeResult.create ~capabilities ~serverInfo () + +let make_error ?(code = Jsonrpc.Response.Error.Code.InternalError) message = + Jsonrpc.Response.Error.make ~message ~code () + +let get_updated_diagnostics_from_log (state : State.t) = + let workspace_root = State.workspace_root state in + let diagnostics = + Diagnostics.collect_diagnostics_from_log_using_source_dirs workspace_root + state.fs + |> Diagnostics.to_lsp_format workspace_root state.store + in + Diagnostics.overwrite ~new_diagnostics:diagnostics (State.diagnostics state) + +(* This intentionally mutates [analysis_state] in place. The analysis layer keeps + package discovery tables as mutable hash tables so later requests can resolve + files and modules without rebuilding package metadata. That makes this + function unsafe in the usual functional sense: callers must provide a fresh + per-server analysis state or accept that repeated calls append/overwrite + package roots as a side effect. *) +let discover_subpackages_and_populate ~workspace_root + ~(analysis_state : Analysis.Shared_types.state) ~server = + let ( /+ ) = Filename.concat in + + let package = + let root_path = workspace_root |> Uri.to_path in + match Analysis.Packages.new_bs_package ~root_path with + | Some p -> Some p + | None -> + (* TODO: When the server starts and the project hasn't been built, (example, + right after cloning a repo), almost all features will not work. + We can use DidChangeWatchedFiles notification to initialize `analysis_state` *) + let message = + Printf.sprintf + "Failed to initialize the context for the project at %s. Try \ + building the project then restart the server" + root_path + in + Server.show_message_notification ~kind:MessageType.Error message server; + None + in + + let resolve_node_modules_paths = + match package with + | Some {dependencies} -> + let paths = + dependencies + |> List.filter_map (fun dep_name -> + let node_modules = + (workspace_root |> Uri.to_path) /+ "node_modules" + in + let path = node_modules /+ dep_name in + (* TODO: Replace with fs.ml module *) + if Analysis.Files.exists path then Some (Unix.realpath path) + else + let rescript = node_modules /+ "rescript" in + if Analysis.Files.exists rescript then + let real_path = Unix.realpath rescript /+ dep_name in + Some real_path + else None) + in + Some paths + | None -> None + in + + (match package with + | Some package -> + Hashtbl.add analysis_state.root_for_uri workspace_root package.root_path; + Hashtbl.add analysis_state.packages_by_root package.root_path package + | None -> ()); + + (match resolve_node_modules_paths with + | Some node_modules_paths -> + node_modules_paths + |> List.iter (fun node_module_path -> + let uri = Uri.of_path node_module_path in + match + Analysis.Packages.new_bs_package ~root_path:node_module_path + with + | Some package -> + Hashtbl.add analysis_state.root_for_uri uri package.root_path; + Hashtbl.add analysis_state.packages_by_root package.root_path + package + | None -> ()); + () + | None -> ()) + |> ignore + +let on_initialize (params : InitializeParams.t) (server : State.t Server.t) = + let state = Server.state server in + + let diagnostics = + Diagnostics.create ~diagnostics:(Diagnostics.empty ()) + ~send:(fun publish_diagnostics_params -> + Server.notification + (Server_notification.PublishDiagnostics publish_diagnostics_params) + server) + in + + let analysis_state = Analysis.Shared_types.create_state () in + + let workspace_root = Helpers.workspace_root_uri_of_initialize_params params in + + discover_subpackages_and_populate ~workspace_root ~analysis_state ~server; + + let compiler_config = + analysis_state.packages_by_root |> Hashtbl.to_seq + |> Seq.filter_map (fun (root_path, _) -> + match Compiler_config.parse ~root:root_path ~fs:state.fs with + | Ok config -> Some (Uri.of_path root_path, config) + | Error _ -> + (* TODO: Send notification? *) + None) + |> Compiler_config.Uri_map.of_seq + in + + let state = + State.initialize state ~params ~diagnostics ~analysis_state ~compiler_config + in + let initialization_info = initialization params.capabilities in + (initialization_info, state) + +let on_request (Client_request.E request) (server : State.t Server.t) = + let load_full uri (state : State.t) = + let package_for_path t ~path = + let analysis_state = State.analysis_state t in + let roots = + analysis_state.packages_by_root |> Hashtbl.to_seq_keys |> List.of_seq + in + match Helpers.best_root_match ~path roots with + | Some root -> Hashtbl.find_opt analysis_state.packages_by_root root + | None -> None + in + + match state.status with + | Initialized _ -> ( + let path = uri |> Uri.to_path in + match package_for_path state ~path with + | Some package -> ( + let module_name = + Analysis.Build_system.namespaced_name package.namespace + (Analysis.Find_files.get_name path) + in + match + Analysis.Cmt.full_for_incremental_cmt ~package ~module_name ~uri + with + | Some cmt_info -> Some cmt_info + | None -> ( + match Hashtbl.find_opt package.paths_for_module module_name with + | Some paths -> + let cmt = Analysis.Shared_types.get_cmt_path ~uri paths in + Analysis.Cmt.full_for_cmt ~module_name ~package ~uri cmt + | None -> None)) + | None -> None) + | Uninitialized -> None + in + + let ok value = Ok (Client_request.yojson_of_result request value) in + let error ?code message = Error (make_error ?code message) in + + let state = Server.state server in + + match request with + | Client_request.Initialize params -> + let initialization_info, state = on_initialize params server in + (ok initialization_info, state) + | TextDocumentHover {position; textDocument = {uri}} -> + let source = (Document_store.get ~uri state.store).text in + let full = load_full uri state in + let hover = + Analysis.Commands.hover + ~state:(State.analysis_state state) + ~source ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~debug:false + ~supports_markdown_links: + state.configuration.hover.support_markdown_links ~full + in + (ok hover, state) + | TextDocumentCompletion {textDocument = {uri}; position} -> + let source = (Document_store.get ~uri state.store).text in + let full = load_full uri state in + + let comp = + Analysis.Commands.completion + ~state:(State.analysis_state state) + ~debug:false ~source ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~full + in + (ok (Some (`List comp)), state) + | CompletionItemResolve item -> + let resp = + match (item.documentation, item.data) with + (* + documentation === null && item.data != null + See https://github.com/rescript-lang/rescript-vscode/blob/2bc69d29ed92e19b14054952bafe9d4af7bd4c4b/server/src/server.ts#L958-L970 + *) + | None, Some (`Assoc fields) -> ( + let file_path = List.assoc_opt "filePath" fields in + let module_path = List.assoc_opt "modulePath" fields in + match (file_path, module_path) with + | Some (`String file_path), Some (`String module_path) -> + let full = load_full (Uri.of_path file_path) state in + let documentation = + Analysis.Commands.completion_resolve + ~state:(State.analysis_state state) + ~full ~module_path + in + Some {item with documentation} + | _ -> None) + | _ -> None + in + (ok (resp |> Option.value ~default:item), state) + | SignatureHelp {textDocument = {uri}; position} -> + if state.configuration.signature_help.enable then + let source = (Document_store.get ~uri state.store).text in + let full = load_full uri state in + let resp = + match + Analysis.Commands.signature_help + ~state:(State.analysis_state state) + ~source ~kind_file:(Document.kind uri) + ~pos:(position.line, position.character) + ~full + ~allow_for_constructor_payloads: + state.configuration.signature_help.for_constructor_payloads + ~debug:false + with + | Some s -> s + | None -> SignatureHelp.create ~signatures:[] () + in + (ok resp, state) + else (ok (SignatureHelp.create ~signatures:[] ()), state) + | TextDocumentDefinition {textDocument = {uri}; position} -> + let full = load_full uri state in + let resp = + match + Analysis.Commands.definition + ~state:(State.analysis_state state) + ~full + ~pos:(position.line, position.character) + ~debug:false + with + | Some loc -> Some (`Location [loc]) + | None -> None + in + (ok resp, state) + | TextDocumentTypeDefinition {textDocument = {uri}; position} -> + let full = load_full uri state in + let resp = + match + Analysis.Commands.type_definition + ~state:(State.analysis_state state) + ~full + ~pos:(position.line, position.character) + ~debug:false + with + | Some loc -> Some (`Location [loc]) + | None -> None + in + (ok resp, state) + | TextDocumentReferences {textDocument = {uri}; position} -> + (* TODO: Bug on Neovim and zed *) + let full = load_full uri state in + let resp = + Analysis.Commands.references + ~state:(State.analysis_state state) + ~full + ~pos:(position.line, position.character) + ~debug:false + in + (ok (Some resp), state) + | DocumentSymbol {textDocument = {uri}} -> ( + (* NOTE: Client side bug. For some reason, Neovim requests the document symbol before sending the TextDocumentDidOpen notification. *) + match Document_store.get_opt ~uri state.store with + | None -> (ok (Some (`DocumentSymbol [])), state) + | Some {text} -> + let resp = + Analysis.Document_symbol.get_symbols ~source:text + ~kind_file:(Document.kind uri) + in + (ok (Some (`DocumentSymbol resp)), state)) + | CodeAction + {textDocument = {uri}; range = {start; end_}; context = {diagnostics}} -> + let full = load_full uri state in + let source = (Document_store.get ~uri state.store).text in + let code_actions_from_compiler_log = + Code_actions.From_diagnostics.get ~uri ~diagnostics ~source + in + let code_actions_from_analysis = + Analysis.Xform.extract_code_actions + ~state:(State.analysis_state state) + ~path:(Uri.to_path uri) + ~start_pos:(start.line, start.character) + ~end_pos:(end_.line, end_.character) + ~source ~kind_file:(Document.kind uri) ~full ~debug:false + in + let other_actions = + let client_support_window_show_document = + match (State.params state).capabilities.window with + | Some {showDocument = Some {support}} -> support = true + | _ -> false + in + + let open_compiled_file = + if client_support_window_show_document then + Code_actions.Open_compiled_file.create ~uri ~state + else [] + in + + let create_interface_file = + Code_actions.Create_interface_file.create ~uri ~state + in + + let switch_implementation_interface_file = + if client_support_window_show_document then + Code_actions.Switch_implementation_interface_file.create ~uri ~state + else [] + in + + open_compiled_file @ create_interface_file + @ switch_implementation_interface_file + in + let resp = + code_actions_from_compiler_log @ code_actions_from_analysis + @ other_actions + |> List.map (fun ca -> `CodeAction ca) + in + (ok (Some resp), state) + | TextDocumentCodeLens {textDocument = {uri}} -> + if state.configuration.code_lens then + let source = (Document_store.get ~uri state.store).text in + let full = load_full uri state in + let resp = + Analysis.Hint.code_lens ~source ~kind_file:(Document.kind uri) ~full + ~debug:false + in + (ok (resp |> Option.value ~default:[]), state) + else (ok [], state) + | InlayHint {textDocument = {uri}; range = {start; end_}} -> + if state.configuration.inlay_hints.enable then + let source = (Document_store.get ~uri state.store).text in + let full = load_full uri state in + let resp = + Analysis.Hint.inlay + ~state:(State.analysis_state state) + ~source ~kind_file:(Document.kind uri) ~full + ~pos:(start.line, end_.line) + ~max_length:state.configuration.inlay_hints.max_length ~debug:false + in + (ok resp, state) + else (ok None, state) + | SemanticTokensFull {textDocument = {uri}} -> + let source = (Document_store.get ~uri state.store).text in + let resp = + Analysis.Semantic_tokens.semantic_tokens ~source + ~kind_file:(Document.kind uri) + in + (ok (Some resp), state) + | TextDocumentRename {textDocument = {uri}; position; newName} -> + let full = load_full uri state in + let resp = + match + Analysis.Commands.rename + ~state:(State.analysis_state state) + ~full + ~pos:(position.line, position.character) + ~new_name:newName ~debug:false + with + | Some we -> we + | None -> WorkspaceEdit.create () + in + (ok resp, state) + | TextDocumentPrepareRename {textDocument = {uri}; position} -> + let full = load_full uri state in + let resp = + match + Analysis.Commands.prepare_rename ~full + ~pos:(position.line, position.character) + ~debug:false + with + | Some {range} -> Some range + | None -> None + in + (ok resp, state) + | TextDocumentFormatting {textDocument = {uri}} -> ( + let source = (Document_store.get ~uri state.store).text in + let kind_file = Document.kind uri in + + let format ~source = + let full_document_text_edit text = + let lines = String.split_on_char '\n' text in + (* TODO: Revisit this *) + let end_line, end_character = + match List.rev lines with + | [] -> (0, 0) + | last_line :: rest -> + (List.length rest - 1, String.length last_line - 1) + in + let range = + Range.create + ~start:(Position.create ~line:0 ~character:0) + ~end_:(Position.create ~line:end_line ~character:end_character) + in + [TextEdit.create ~range ~newText:text] + in + + let read_all_from_channel channel = + let buffer = Buffer.create 4096 in + let bytes = Bytes.create 4096 in + let rec loop () = + match input channel bytes 0 (Bytes.length bytes) with + | 0 -> Buffer.contents buffer + | read -> + Buffer.add_subbytes buffer bytes 0 read; + loop () + in + loop () + in + + let process_status_to_string = function + | Unix.WEXITED code -> Printf.sprintf "exited with code %d" code + | Unix.WSIGNALED signal -> Printf.sprintf "killed by signal %d" signal + | Unix.WSTOPPED signal -> Printf.sprintf "stopped by signal %d" signal + in + + (* TODO: Run with Eio_unix.run_in_systhread? *) + let executable = + let executable_name = + if Sys.win32 then "rescript.cmd" else "rescript" + in + let root_path = State.workspace_root state |> Uri.to_path in + let ( /+ ) = Filename.concat in + root_path /+ "node_modules" /+ ".bin" /+ executable_name + in + let extension_name = Document.to_string kind_file in + let stdin, stdout = + Unix.open_process_args executable + [|executable; "format"; "--stdin"; "." ^ extension_name|] + in + let close_process_noerr () = + try ignore (Unix.close_process (stdin, stdout)) with _ -> () + in + try + output_string stdout source; + close_out stdout; + let formatted = read_all_from_channel stdin in + match Unix.close_process (stdin, stdout) with + | Unix.WEXITED 0 -> Ok (full_document_text_edit formatted) + | status -> + Error + (Printf.sprintf "%s %s" executable + (process_status_to_string status)) + with exn -> + close_out_noerr stdout; + close_in_noerr stdin; + close_process_noerr (); + Error (Printexc.to_string exn) + in + + match + Analysis.Diagnostics.document_syntax ~source ~kind_file |> List.is_empty + with + | true -> ( + match format ~source with + | Ok formatted -> (ok (Some formatted), state) + | Error message -> + (error ("Failed to run rescript format using. " ^ message), state)) + | false -> + (* If document has syntax errors respond with null *) + (ok None, state)) + | Shutdown -> (ok (), state) + | ExecuteCommand {command; arguments} -> + let request_show_document ~uri ~takeFocus = + let client_support_window_show_document = + match (State.params state).capabilities.window with + | Some {showDocument = Some {support}} -> support = true + | _ -> false + in + if client_support_window_show_document then ( + Server.request + (Server_request.ShowDocumentRequest + (ShowDocumentParams.create ~takeFocus ~uri ())) + server; + (ok `Null, state)) + else + (* TODO: Send window/showMessage? *) + let message = + match (State.params state).clientInfo with + | Some {name; version} -> + Printf.sprintf + "The client %s (version %s) dont support window/showDocument \ + request" + name + (Option.value version ~default:"unknown") + | None -> "The client dont support window/showDocument request" + in + (error message, state) + in + + if String.equal command Execute_commands.open_compiled then + match arguments with + | Some [`String uri] -> + request_show_document ~uri:(Uri.of_string uri) ~takeFocus:true + | _ -> + ( error + (Printf.sprintf + "Invalid arguments for workspace/executeCommand %s. Expected a \ + list of string: [uri]" + Execute_commands.open_compiled), + state ) + else if String.equal command Execute_commands.create_interface then + match arguments with + | Some [`String uri; `String cmi_uri] -> ( + match + Custom_requests.Create_interface_file.create ~uri:(Uri.of_string uri) + ~cmi_uri:(Uri.of_string cmi_uri) ~state + with + | Ok uri -> request_show_document ~uri ~takeFocus:true + | Error _ -> + (* TODO: Send window/showMessage?. If user dont build the project the cmi file dont exists *) + ( error + (Printf.sprintf "Failed to create interface file for %s and %s" + uri cmi_uri), + state )) + | _ -> + ( error + (Printf.sprintf + "Invalid arguments for workspace/executeCommand %s. Expected a \ + list of string: [uri, cmi_uri]" + Execute_commands.create_interface), + state ) + else if + String.equal command Execute_commands.switch_implementation_interface + then + match arguments with + | Some [`String uri] -> + request_show_document ~uri:(Uri.of_string uri) ~takeFocus:true + | _ -> + ( error + (Printf.sprintf + "Invalid arguments for workspace/executeCommand %s. Expected a \ + list of string: [uri]" + Execute_commands.switch_implementation_interface), + state ) + else if String.equal command Execute_commands.dump_server_state then + let json = State.to_yojson state |> Yojson.Safe.pretty_to_string in + let response = `Assoc [("content", `String json)] in + (ok response, state) + else + ( error + (Printf.sprintf + "Unknown command %s for workspace/executeCommand request" command), + state ) + | DebugTextDocumentGet _ | DebugEcho _ | WorkspaceSymbol _ + | CodeActionResolve _ | TextDocumentColor _ | TextDocumentColorPresentation _ + | TextDocumentCodeLensResolve _ | TextDocumentHighlight _ + | TextDocumentFoldingRange _ | TextDocumentLinkResolve _ | TextDocumentLink _ + | WillSaveWaitUntilTextDocument _ | TextDocumentRangeFormatting _ + | TextDocumentOnTypeFormatting _ | SelectionRange _ + | TextDocumentImplementation _ | SemanticTokensDelta _ | TextDocumentMoniker _ + | TextDocumentPrepareCallHierarchy _ | CallHierarchyIncomingCalls _ + | CallHierarchyOutgoingCalls _ | SemanticTokensRange _ | LinkedEditingRange _ + | WillCreateFiles _ | WillRenameFiles _ | WillDeleteFiles _ + | InlayHintResolve _ | TextDocumentDiagnostic _ + | TextDocumentInlineCompletion _ | TextDocumentInlineValue _ + | WorkspaceSymbolResolve _ | WorkspaceDiagnostic _ + | TextDocumentRangesFormatting _ | TextDocumentPrepareTypeHierarchy _ + | TypeHierarchySupertypes _ | TypeHierarchySubtypes _ + | TextDocumentDeclaration _ -> + (error "Request not supported yet!", state) + | UnknownRequest {meth; params} -> ( + let open Custom_requests in + match + List.assoc_opt meth + [ + (Create_interface_file.meth, Create_interface_file.on_request); + (Open_compiled_file.meth, Open_compiled_file.on_request); + ] + with + | Some handler -> (handler ~params ~state, state) + | None -> + ( error ?code:(Some Jsonrpc.Response.Error.Code.InvalidRequest) + (Printf.sprintf "Unknown request %s" meth), + state )) + +let on_notification notification (server : State.t Server.t) = + let state = Server.state server in + + match notification with + | Client_notification.TextDocumentDidOpen + {textDocument = {uri; text; version; _}} -> + let store = Document_store.add ~uri ~text ~version state.store in + let diagnostics = get_updated_diagnostics_from_log state in + diagnostics |> Diagnostics.send; + {state with store} |> State.update_diagnostics diagnostics + | TextDocumentDidChange {contentChanges; textDocument = {uri; version}} -> + let store = + match List.rev contentChanges with + | {text} :: _ -> Document_store.update ~uri ~text ~version state.store + | [] -> state.store + in + let diagnostics = get_updated_diagnostics_from_log state in + let syntax_erros_diagnostics = + Diagnostics.from_uri ~uri + (Analysis.Diagnostics.document_syntax + ~source:(Document_store.get ~uri store).text + ~kind_file:(Document.kind uri)) + in + + let diagnostics = + Diagnostics.append ~new_diagnostics:syntax_erros_diagnostics diagnostics + in + + diagnostics |> Diagnostics.send; + {state with store} |> State.update_diagnostics diagnostics + | TextDocumentDidClose {textDocument = {uri; _}} -> + let store = Document_store.remove ~uri state.store in + let diagnostics = get_updated_diagnostics_from_log state in + diagnostics |> Diagnostics.send; + {state with store} |> State.update_diagnostics diagnostics + | Initialized -> + (* Register dynamic file watchers for compiler log files. + ReScript writes one .compiler.log per build root. In monorepos, + .sourcedirs.json contains the build_root entries for each subpackage, + so use it to watch every generated compiler log and refresh diagnostics + when any of them changes. *) + let watchers = + [WatchKind.Create; Change; Delete] + |> List.map (fun kind -> + FileSystemWatcher.create + ~kind + (* NOTE: Clients dont send notification `workspace/didChangeWatchedFiles` + when pattern is a relative path `lib/bs/.compiler.log` of full path + `{workspace_root}/lib/bs/.compiler.log`. The glob should start with `**` + *) + ~globPattern:(`Pattern ("**/lib/bs/" ^ Constants.compiler_log)) + ()) + in + + let registerOptions = + DidChangeWatchedFilesRegistrationOptions.create ~watchers + |> DidChangeWatchedFilesRegistrationOptions.yojson_of_t + in + let registration = + Registration.create ~id:"rescript_file_watchers" + ~method_:"workspace/didChangeWatchedFiles" ~registerOptions () + in + let params = RegistrationParams.create ~registrations:[registration] in + Server.request (Server_request.ClientRegisterCapability params) server; + + state + | Exit -> state + | DidChangeWatchedFiles _ -> + (* Do not limit diagnostics to the path reported by + DidChangeWatchedFilesParams. In monorepos, a build in one subpackage + can change diagnostics that should be shown for files in another + subpackage. Re-read every compiler log listed in .sourcedirs.json so + stale errors are cleared and cross-package diagnostics stay in sync. *) + let diagnostics = get_updated_diagnostics_from_log state in + diagnostics |> Diagnostics.send; + state |> State.update_diagnostics diagnostics + | ChangeConfiguration _ -> + (* workspace/didChangeConfiguration only signals that settings may have + changed. The LSP configuration model is pull-based, so the server should + ignore this notification payload and fetch the scoped settings it needs + with workspace/configuration. + + See https://github.com/microsoft/language-server-protocol/issues/567#issuecomment-448538082 + *) + Server.request + (Server_request.WorkspaceConfiguration + (ConfigurationParams.create + ~items:[ConfigurationItem.create ~section:"rescript" ()])) + server; + state + | ChangeWorkspaceFolders _ | CancelRequest _ | DidSaveTextDocument _ + | DidCreateFiles _ | DidDeleteFiles _ | DidRenameFiles _ + | WillSaveTextDocument _ | WorkDoneProgressCancel _ | WorkDoneProgress _ + | NotebookDocumentDidOpen _ | NotebookDocumentDidChange _ + | NotebookDocumentDidSave _ | NotebookDocumentDidClose _ | SetTrace _ -> + state + | UnknownNotification {method_} -> + Server.log_message_notification ~kind:MessageType.Error + ("Unknown notication " ^ method_) + server; + state + +(* TODO: Revisit this *) +let on_response + (Server.Response_result (request, result) : Server.response_result) + (server : State.t Server.t) = + let request_error_message = function + | Server.Response_error error -> error.message + | Server.Decode_error exn -> Printexc.to_string exn + in + + let state = Server.state server in + + match (request, result) with + | Server_request.WorkspaceConfiguration _, result -> ( + match result with + | Ok [settings] -> ( + match Configuration.of_yojson settings with + | Ok configuration -> {state with configuration} + | Error _ -> state) + | Ok _ -> + Server.show_message_notification ~kind:MessageType.Error + "Invalid rescript.settings. Received a list" server; + state + | Error err -> + Server.show_message_notification ~kind:MessageType.Error + ("Error on response of workspace/configuration request: " + ^ request_error_message err) + server; + state) + | _ -> state + +let listen ~input ~output ~fs = + let state = + State.create ~store:(Document_store.create ()) + ~configuration:Configuration.default ~fs + in + Server.listen ~input ~output ~on_request ~on_notification ~on_response ~state diff --git a/lsp/src/server.ml b/lsp/src/server.ml new file mode 100644 index 00000000000..c92d6bb7056 --- /dev/null +++ b/lsp/src/server.ml @@ -0,0 +1,287 @@ +module Io : sig + type 'a t + + val return : 'a -> 'a t + val raise : exn -> 'a t + val await : 'a t -> 'a + val async : (sw:Eio.Switch.t -> ('a, exn) result) -> 'a t + + module O : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + end +end = struct + type 'a t = sw:Eio.Switch.t -> ('a, exn) result Eio.Promise.t + + let await t = Eio.Switch.run @@ fun sw -> Eio.Promise.await_exn (t ~sw) + let return value ~sw:_ = Eio.Promise.create_resolved (Ok value) + let error desc ~sw:_ = Eio.Promise.create_resolved (Error desc) + + let async f ~sw = + let promise, resolver = Eio.Promise.create () in + ( Eio.Fiber.fork ~sw @@ fun () -> + try + let result = f ~sw in + Eio.Promise.resolve resolver result + with exn -> Eio.Promise.resolve resolver @@ Error exn ); + promise + + let bind t f = + async @@ fun ~sw -> + match Eio.Promise.await (t ~sw) with + | Ok value -> Eio.Promise.await @@ f value ~sw + | Error desc -> Error desc + + let raise = error + + module O = struct + let ( let+ ) x f = bind x @@ fun value -> return @@ f value + let ( let* ) = bind + end +end + +module Chan : sig + type input + type output + + val of_source : [> Eio__Flow.source_ty] Eio.Resource.t -> input + val with_sink : [> Eio__Flow.sink_ty] Eio.Resource.t -> (output -> 'a) -> 'a + + val read_line : input -> string option Io.t + val read_exactly : input -> int -> string option Io.t + val write : output -> string list -> unit Io.t +end = struct + type input = {mutex: Eio.Mutex.t; buf: Eio.Buf_read.t} + type output = {mutex: Eio.Mutex.t; buf: Eio.Buf_write.t} + + let initial_size = 1024 + let max_size = 1024 * 1024 + + let of_source source : input = + let mutex = Eio.Mutex.create () in + let buf = Eio.Buf_read.of_flow ~initial_size ~max_size source in + {mutex; buf} + + let with_sink sink f = + let mutex = Eio.Mutex.create () in + Eio.Buf_write.with_flow ~initial_size sink @@ fun buf -> f {mutex; buf} + + let read_line (input : input) = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> + if Eio.Buf_read.eof_seen input.buf then Ok None + else + match Eio.Buf_read.line input.buf with + | line -> Ok (Some line) + | exception End_of_file -> Ok None + + let read_exactly (input : input) size = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true input.mutex @@ fun () -> + if Eio.Buf_read.eof_seen input.buf then Ok None + else + match Eio.Buf_read.take size input.buf with + | data -> Ok (Some data) + | exception End_of_file -> Ok None + + let write (output : output) (str : string list) = + Io.async @@ fun ~sw:_ -> + Eio.Mutex.use_rw ~protect:true output.mutex @@ fun () -> + Ok (List.iter (Eio.Buf_write.string output.buf) str) +end + +module Lsp_Io = Lsp.Io.Make (Io) (Chan) + +let notification_of_jsonrpc notification = + match Lsp.Client_notification.of_jsonrpc notification with + | Ok notification -> notification + | Error error -> raise (Lsp.Io.Error error) + +module Request_id = struct + type t = Jsonrpc.Id.t + + let equal = Jsonrpc.Id.equal + let hash = Jsonrpc.Id.hash +end + +module Request_id_table = Hashtbl.Make (Request_id) + +type request_error = + | Response_error of Jsonrpc.Response.Error.t + | Decode_error of exn + +type response_result = + | Response_result : + 'a Lsp.Server_request.t * ('a, request_error) result + -> response_result + +type pending_request = Pending : 'a Lsp.Server_request.t -> pending_request + +type request_context = { + mutable next_id: int; + pending: pending_request Request_id_table.t; +} + +type 'a t = {channel: Chan.output; state: 'a; request_context: request_context} + +let state t = t.state + +let respond server response = + Io.await @@ Lsp_Io.write server.channel @@ Response response + +let notification notification server = + let notification = Lsp.Server_notification.to_jsonrpc notification in + Io.await @@ Lsp_Io.write server.channel @@ Notification notification + +let request request server = + let id = `Int server.request_context.next_id in + server.request_context.next_id <- server.request_context.next_id + 1; + Request_id_table.add server.request_context.pending id (Pending request); + let request = Lsp.Server_request.to_jsonrpc_request request ~id in + try Io.await @@ Lsp_Io.write server.channel @@ Request request + with exn -> + Request_id_table.remove server.request_context.pending id; + raise exn + +let handle_response (response : Jsonrpc.Response.t) server = + match + Request_id_table.find_opt server.request_context.pending response.id + with + | None -> None + | Some (Pending request) -> ( + Request_id_table.remove server.request_context.pending response.id; + match response.result with + | Ok json -> + let result = + match Lsp.Server_request.response_of_json request json with + | response -> Ok response + | exception exn -> Error (Decode_error exn) + in + Some (Response_result (request, result)) + | Error err -> + let result = Error (Response_error err) in + Some (Response_result (request, result))) + +let log_message_notification ?(kind = Lsp.Types.MessageType.Debug) message + server = + notification + (Lsp.Server_notification.LogMessage + (Lsp.Types.LogMessageParams.create ~type_:kind ~message)) + server + +let show_message_notification ?(kind = Lsp.Types.MessageType.Info) message + server = + notification + (Lsp.Server_notification.ShowMessage + (Lsp.Types.ShowMessageParams.create ~type_:kind ~message)) + server + +type lifecycle = Awaiting_initialize | Running | Shutdown_requested + +let error_response ~id ~code ~message = + let err = Jsonrpc.Response.Error.make ~code ~message () in + Jsonrpc.Response.{id; result = Error err} + +let is_initialize_request (request : Jsonrpc.Request.t) = + request.method_ = "initialize" + +let is_shutdown_request (request : Jsonrpc.Request.t) = + request.method_ = "shutdown" + +let is_exit_notification (notification : Jsonrpc.Notification.t) = + notification.method_ = "exit" + +let exit_from_lifecycle lifecycle = + let exit_code = + match lifecycle with + | Shutdown_requested -> 0 + | _ -> 1 + in + exit exit_code + +let rec input_loop ~input ~state with_ = + match Io.await @@ Lsp_Io.read input with + | Some packet -> + let state = with_ state packet in + input_loop ~input ~state with_ + | exception _ -> failwith "Server.input_loop" + | None -> () + +let listen ~input ~output ~on_request ~on_notification ~on_response ~state = + let lifecycle = ref Awaiting_initialize in + let handle_request server request = + match !lifecycle with + | Awaiting_initialize when not (is_initialize_request request) -> + respond server + (error_response ~id:request.id + ~code:Jsonrpc.Response.Error.Code.ServerNotInitialized + ~message:"Server has not received an initialize request"); + server.state + | Running when is_initialize_request request -> + respond server + (error_response ~id:request.id + ~code:Jsonrpc.Response.Error.Code.InvalidRequest + ~message:"Server has already been initialized"); + server.state + | Shutdown_requested -> + respond server + (error_response ~id:request.id + ~code:Jsonrpc.Response.Error.Code.InvalidRequest + ~message:"Server has already received a shutdown request"); + server.state + | Awaiting_initialize | Running -> + let response, state = + match Lsp.Client_request.of_jsonrpc request with + | Error message -> + let code = Jsonrpc.Response.Error.Code.InvalidParams in + let err = Jsonrpc.Response.Error.make ~code ~message () in + (Jsonrpc.Response.{id = request.id; result = Error err}, state) + | Ok packed -> + let result, state = on_request packed server in + (Jsonrpc.Response.{id = request.id; result}, state) + in + respond server response; + (match response.result with + | Ok _ when is_initialize_request request -> lifecycle := Running + | Ok _ when is_shutdown_request request -> lifecycle := Shutdown_requested + | Ok _ | Error _ -> ()); + state + in + let handle_notification server notification = + if is_exit_notification notification then exit_from_lifecycle !lifecycle + else + match !lifecycle with + | Awaiting_initialize | Shutdown_requested -> server.state + | Running -> on_notification (notification_of_jsonrpc notification) server + in + let input = Chan.of_source input in + Chan.with_sink output (fun channel -> + let request_context = + {next_id = 1; pending = Request_id_table.create 16} + in + input_loop ~input ~state (fun state packet -> + let server = {channel; state; request_context} in + match packet with + | Notification notification -> handle_notification server notification + | Request request -> handle_request server request + | Batch_call calls -> + List.fold_left + (fun state call -> + let server = {channel; state; request_context} in + match call with + | `Request request -> handle_request server request + | `Notification notification -> + handle_notification server notification) + state calls + | Response response -> ( + match handle_response response server with + | Some response -> on_response response server + | None -> state) + | Batch_response responses -> + List.fold_left + (fun state response -> + let server = {channel; state; request_context} in + match handle_response response server with + | Some response -> on_response response server + | None -> state) + state responses)) diff --git a/lsp/src/source_dirs.ml b/lsp/src/source_dirs.ml new file mode 100644 index 00000000000..c666fcea5ac --- /dev/null +++ b/lsp/src/source_dirs.ml @@ -0,0 +1,93 @@ +let get_build_roots_from_json json = + let build_roots = + match json with + | `Assoc fields -> ( + match List.assoc_opt "cmt_scan" fields with + | Some (`List cmt_scan_items) -> + let build_roots = + List.filter_map + (fun (cmt_scan_item : Yojson.Safe.t) -> + match cmt_scan_item with + | `Assoc cmt_scan_fields -> ( + match List.assoc_opt "build_root" cmt_scan_fields with + | Some (`String build_root) -> Some build_root + | _ -> None) + | _ -> None) + cmt_scan_items + in + Some build_roots + | _ -> None) + | _ -> None + in + build_roots + +let get_build_roots_from_file ~fs path = + match Fs.load ~fs path with + | Some content -> ( + match Yojson.Safe.from_string content with + | json -> get_build_roots_from_json json + | exception _ -> None) + | None -> None + +let%expect_test "get_build_roots" = + let print_build_roots result = + match result with + | None -> () + | Some l -> List.iter print_endline l + in + let json_1 = + Yojson.Safe.from_string + {| +{ + "cmt_scan": [ + { + "build_root": "path/to/lib/bs" + } + ] +} + |} + in + + json_1 |> get_build_roots_from_json |> print_build_roots; + [%expect {| path/to/lib/bs |}]; + + let json_2 = + Yojson.Safe.from_string + {| +{ +"cmt_scan": [ + { + "build_root": "path/to/lib/bs" + }, + { + "build_root": "path2/to/lib/bs" + } +] +} + |} + in + + json_2 |> get_build_roots_from_json |> print_build_roots; + [%expect {| + path/to/lib/bs + path2/to/lib/bs + |}]; + + let json_3 = + Yojson.Safe.from_string + {| +{ +"cmt_scan": [ +{ + "build_root": [] +}, +{ + "build_root": {} +} +] +} +|} + in + + json_3 |> get_build_roots_from_json |> print_build_roots; + [%expect {| |}] diff --git a/lsp/src/state.ml b/lsp/src/state.ml new file mode 100644 index 00000000000..0575f4bb87f --- /dev/null +++ b/lsp/src/state.ml @@ -0,0 +1,114 @@ +open Lsp.Types + +type status = + | Uninitialized + | Initialized of { + params: InitializeParams.t; + diagnostics: Diagnostics.t; + analysis_state: Analysis.Shared_types.state; + compiler_config: Compiler_config.t; + } + +type t = { + status: status; + store: Document_store.t; + configuration: Configuration.t; + fs: Eio.Fs.dir_ty Eio.Path.t; +} + +let create ~store ~configuration ~fs = + {status = Uninitialized; store; configuration; fs} + +let initialize t ~params ~diagnostics ~analysis_state ~compiler_config = + { + t with + status = Initialized {params; diagnostics; analysis_state; compiler_config}; + } + +let diagnostics t = + match t.status with + | Uninitialized -> assert false + | Initialized init -> init.diagnostics + +let params t = + match t.status with + | Uninitialized -> assert false + | Initialized init -> init.params + +(* TODO: rewrite this? *) +let update_diagnostics diagnostics t = + match t.status with + | Uninitialized -> assert false + | Initialized {params; analysis_state; compiler_config} -> + { + t with + status = + Initialized {params; analysis_state; diagnostics; compiler_config}; + } + +let analysis_state t = + match t.status with + | Uninitialized -> assert false + | Initialized {analysis_state} -> analysis_state + +let compiler_config t = + match t.status with + | Uninitialized -> assert false + | Initialized {compiler_config} -> compiler_config + +let workspace_root t = + match t.status with + | Uninitialized -> assert false + | Initialized init -> + Helpers.workspace_root_uri_of_initialize_params init.params + +let to_yojson (t : t) : Yojson.Safe.t = + let document_store_to_yojson (store : Document_store.t) = + store.documents |> Hashtbl.to_seq + |> Seq.map (fun (uri, {Document_store.text; version}) -> + ( Lsp.Uri.to_string uri, + `Assoc + [ + ("version", `Int version); + ("text_length", `Int (String.length text)); + ] )) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let diagnostics_to_yojson (diagnostics : Diagnostics.t) = + diagnostics.diagnostics |> Diagnostics.Uri_map.to_seq + |> Seq.map (fun (uri, diagnostics) -> + ( Lsp.Uri.to_string uri, + `List (List.map Diagnostic.yojson_of_t diagnostics) )) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let compiler_config_to_yojson (compiler_config : Compiler_config.t) = + compiler_config |> Compiler_config.Uri_map.to_seq + |> Seq.map (fun (uri, config) -> + (Lsp.Uri.to_string uri, Compiler_config.Parse.to_yojson config)) + |> List.of_seq + |> fun fields -> `Assoc fields + in + + let status_to_yojson = function + | Uninitialized -> `Assoc [("kind", `String "Uninitialized")] + | Initialized {params; diagnostics; compiler_config} -> + `Assoc + [ + ("kind", `String "Initialized"); + ("params", InitializeParams.yojson_of_t params); + ("diagnostics", diagnostics_to_yojson diagnostics); + ("compiler_config", compiler_config_to_yojson compiler_config); + ] + in + + `Assoc + [ + ("status", status_to_yojson t.status); + ("store", document_store_to_yojson t.store); + ( "analysis_state", + Analysis.Shared_types.state_to_yojson (analysis_state t) ); + ] diff --git a/package.json b/package.json index 88b253b0eca..81df1c032fc 100644 --- a/package.json +++ b/package.json @@ -107,6 +107,7 @@ "tests/tests", "tests/tools_tests", "tests/commonjs_tests", + "tests/lsp_tests/**", "scripts/res" ], "packageManager": "yarn@4.12.0", diff --git a/rescript-language-server.opam b/rescript-language-server.opam new file mode 100644 index 00000000000..33e6a20d90c --- /dev/null +++ b/rescript-language-server.opam @@ -0,0 +1,33 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "ReScript LSP" +maintainer: ["Hongbo Zhang " "Cristiano Calcagno"] +authors: ["Hongbo Zhang "] +license: "LGPL-3.0-or-later" +homepage: "https://github.com/rescript-lang/rescript-compiler" +bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" +depends: [ + "ocaml" {>= "4.10"} + "lsp" {>= "1.22.0"} + "eio" {>= "1.3"} + "eio_main" {>= "1.3"} + "analysis" + "dune" {>= "3.17"} + "ppx_deriving_yojson" + "ppx_expect" {with-test & = "v0.17.2"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] diff --git a/tests/dune b/tests/dune index 01dd377b945..d9dd6567304 100644 --- a/tests/dune +++ b/tests/dune @@ -1 +1 @@ -(dirs ounit_tests syntax_benchmarks syntax_tests) +(dirs ounit_tests syntax_benchmarks syntax_tests lsp_tests) diff --git a/tests/lsp_tests/basic-workspace/Hover.res b/tests/lsp_tests/basic-workspace/Hover.res new file mode 100644 index 00000000000..230cdafee6e --- /dev/null +++ b/tests/lsp_tests/basic-workspace/Hover.res @@ -0,0 +1,286 @@ +let abc = 22 + 34 +// ^hov + +type t = (int, float) +// ^hov + +module Id = { + // ^hov + type x = int +} + +@ocaml.doc("This module is commented") +module Dep: { + @ocaml.doc("Some doc comment") + let customDouble: int => int +} = { + let customDouble = foo => foo * 2 +} + +module D = Dep +// ^hov + +let cd = D.customDouble +// ^hov + +module HoverInsideModuleWithComponent = { + let x = 2 // check that hover on x works + // ^hov + @react.component + let make = () => React.null +} + +@ocaml.doc("Doc comment for functionWithTypeAnnotation") +let functionWithTypeAnnotation: unit => int = () => 1 +// ^hov + +@react.component +let make = (~name) => React.string(name) +// ^hov + +module C2 = { + @react.component + let make2 = (~name: string) => React.string(name) + // ^hov +} + +let num = 34 +// ^hov + +module type Logger = { + // ^hov + let log: string => unit +} + +module JsLogger: Logger = { + // ^hov + let log = (msg: string) => Console.log(msg) + let _oneMore = 3 +} + +module JJ = JsLogger +// ^def + +module IdDefinedTwice = { + // ^hov + let _x = 10 + let y = 20 + let _x = 10 +} + +module A = { + let x = 13 +} + +module B = A +// ^hov + +module C = B +// ^hov + +module Comp = { + @react.component + let make = (~children: React.element) => children +} + +module Comp1 = Comp + +let _ = + +
+
+ +// ^hov + +let _ = + +
+
+ +// ^hov + +type r<'a> = {i: 'a, f: float} + +let _get = r => r.f +. r.i +// ^hov + +let withAs = (~xx as yyy) => yyy + 1 +// ^hov + +module AA = { + type cond<'a> = [< #str(string)] as 'a + let fnnxx = (b: cond<_>) => true ? b : b +} + +let funAlias = AA.fnnxx + +let typeOk = funAlias +// ^hov + +let typeDuplicate = AA.fnnxx +// ^hov + +@live let dd = 34 +// ^hov + +let arity0a = () => { + //^hov + let f = () => 3 + f +} + +let arity0b = ((), ()) => 3 +// ^hov + +let arity0c = ((), ()) => 3 +// ^hov + +let arity0d = () => { + // ^hov + let f = () => 3 + f +} + +/**doc comment 1*/ +let docComment1 = 12 +// ^hov + +/** doc comment 2 */ +let docComment2 = 12 +// ^hov + +module ModWithDocComment = { + /*** module level doc comment 1 */ + + /** doc comment for x */ + let x = 44 + + /*** module level doc comment 2 */ +} + +module TypeSubstitutionRecords = { + type foo<'a> = {content: 'a, zzz: string} + type bar = {age: int} + type foobar = foo + + let x1: foo = {content: {age: 42}, zzz: ""} + // ^hov + let x2: foobar = {content: {age: 42}, zzz: ""} + // ^hov + + // x1.content. + // ^com + + // x2.content. + // ^com + + type foo2<'b> = foo<'b> + type foobar2 = foo2 + + let y1: foo2 = {content: {age: 42}, zzz: ""} + let y2: foobar2 = {content: {age: 42}, zzz: ""} + + // y1.content. + // ^com + + // y2.content. + // ^com +} + +module CompV4 = { + type props<'n, 's> = {n?: 'n, s: 's} + let make = props => { + let _ = props.n == Some(10) + React.string(props.s) + } +} + +let mk = CompV4.make +// ^hov + +type useR = {x: int, y: list>>} + +let testUseR = (v: useR) => v +// ^hov + +let usr: useR = { + x: 123, + y: list{}, +} + +// let f = usr +// ^hov + +module NotShadowed = { + /** Stuff */ + let xx_ = 10 + + /** More Stuff */ + let xx = xx_ +} + +module Shadowed = { + /** Stuff */ + let xx = 10 + + /** More Stuff */ + let xx = xx +} + +let _ = NotShadowed.xx +// ^hov + +let _ = Shadowed.xx +// ^hov + +type recordWithDocstringField = { + /** Mighty fine field here. */ + someField: bool, +} + +let x: recordWithDocstringField = { + someField: true, +} + +// x.someField +// ^hov + +let someField = x.someField +// ^hov + +type variant = + /** Cool variant! */ + | CoolVariant + /** Other cool variant */ + | OtherCoolVariant + +let coolVariant = CoolVariant +// ^hov + +type payloadVariants = InlineRecord({field1: int, field2: bool}) | Args(int, bool) + +let payloadVariant = InlineRecord({field1: 1, field2: true}) +// ^hov + +let payloadVariant2 = Args(1, true) +// ^hov + +module RecursiveVariants = { + type rec t = Action1(int) | Action2(float) | Batch(array) +} + +let recursiveVariant = RecursiveVariants.Action1(1) +// ^hov + +// Hover on unsaved +// let fff = "hello"; fff +// ^hov + +// switch x { | {someField} => someField } +// ^hov + +module Arr = Belt.Array +// ^hov + +type aliased = variant +// ^hov diff --git a/tests/lsp_tests/basic-workspace/Hover.res.expected b/tests/lsp_tests/basic-workspace/Hover.res.expected new file mode 100644 index 00000000000..4baaf2e0253 --- /dev/null +++ b/tests/lsp_tests/basic-workspace/Hover.res.expected @@ -0,0 +1,341 @@ +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:1:5 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:4:6 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\ntype t = (int, float)\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:7:8 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule Id: {\n type x = int\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:20:12 +Response +{ + "contents": { + "kind": "markdown", + "value": "\nThis module is commented\n---\n\n```\n \n```\n```rescript\nmodule Dep: {\n let customDouble: int => int\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:23:12 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint => int\n```\n---\nSome doc comment" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:27:7 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:34:5 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nunit => int\n```\n---\nDoc comment for functionWithTypeAnnotation" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:38:14 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nstring\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:43:16 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nstring\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:47:11 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:50:14 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule type Logger = {\n let log: string => unit\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:55:8 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule type Logger = {\n let log: string => unit\n}\n```" + } +} + +Command `def` not implemented! tests/lsp_tests/basic-workspace/Hover.res:61:15 + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:64:10 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule IdDefinedTwice: {\n let y: int\n let _x: int\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:75:8 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule A: {\n let x: int\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:78:8 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nmodule A: {\n let x: int\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:92:11 +Response +null + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:99:11 +Response +null + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:104:26 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nfloat\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:107:22 +Response +{ "contents": { "kind": "markdown", "value": "```rescript\nint\n```" } } + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:117:17 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nAA.cond<([< #str(string)] as 'a)> => AA.cond<'a>\n```\n\n---\n```rescript\ntype AA.cond<'a> = 'a\n constraint 'a = [< #str(string)]\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:120:26 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nAA.cond<([< #str(string)] as 'a)> => AA.cond<'a>\n```\n\n---\n```rescript\ntype AA.cond<'a> = 'a\n constraint 'a = [< #str(string)]\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:123:4 +Response +{ + "contents": { + "kind": "markdown", + "value": "The `@live` decorator is for reanalyze, a static analysis tool for ReScript that can do dead code analysis.\n\n`@live` tells the dead code analysis that the value should be considered live, even though it might appear to be dead. This is typically used in case of FFI where there are indirect ways to access values. It can be added to everything that could otherwise be considered unused by the dead code analysis - values, functions, arguments, records, individual record fields, and so on.\n\n[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#live-decorator).\n\nHint: Did you know you can run an interactive code analysis in your project by running the command `> ReScript: Start Code Analyzer`? Try it!" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:132:5 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\n(unit, unit) => int\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:135:5 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\n(unit, unit) => int\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:138:6 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nunit => unit => int\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:145:10 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\ndoc comment 1" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:149:7 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\n doc comment 2 " + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:166:24 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nfoo\n```\n\n---\n```rescript\ntype foo<'a> = {content: 'a, zzz: string}\n```\n\n\n---\n```rescript\ntype bar = {age: int}\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:168:23 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nfoobar\n```\n\n---\n```rescript\ntype foobar = foo\n```\n" + } +} + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:171:17 + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:174:17 + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:183:17 + +Command `com` not implemented! tests/lsp_tests/basic-workspace/Hover.res:186:17 + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:198:5 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nCompV4.props => React.element\n```\n\n---\n```rescript\ntype CompV4.props<'n, 's> = {n?: 'n, s: 's}\n```\n\n\n---\n```rescript\ntype React.element = Jsx.element\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:203:17 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nuseR\n```\n\n---\n```rescript\ntype useR = {x: int, y: list>>}\n```\n\n\n---\n```rescript\ntype r<'a> = {i: 'a, f: float}\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:211:14 +Response +null + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:230:21 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\n More Stuff " + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:233:18 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nint\n```\n---\n More Stuff " + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:245:7 +Response +null + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:248:20 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nbool\n```\n---\n Mighty fine field here. " + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:257:21 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nvariant\nCoolVariant\n```\n---\n Cool variant! \n\n---\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:262:23 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\npayloadVariants\nInlineRecord({field1: int, field2: bool})\n```\n\n---\n```rescript\ntype payloadVariants =\n | InlineRecord({field1: int, field2: bool})\n | Args(int, bool)\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:265:24 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\npayloadVariants\nArgs(int, bool)\n```\n\n---\n```rescript\ntype payloadVariants =\n | InlineRecord({field1: int, field2: bool})\n | Args(int, bool)\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:272:43 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\nRecursiveVariants.t\nAction1(int)\n```\n\n---\n```rescript\ntype RecursiveVariants.t =\n | Action1(int)\n | Action2(float)\n | Batch(array)\n```\n" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:276:24 +Response +null + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:279:34 +Response +null + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:282:9 +Response +{ + "contents": { + "kind": "markdown", + "value": "\n [`Belt.Array`]()\n\n **mutable array**: Utilities functions\n\n---\n\n```\n \n```\n```rescript\nmodule Array: {\n module Id\n module Array\n module SortArray\n module MutableQueue\n module MutableStack\n module List\n module Range\n module Set\n module Map\n module MutableSet\n module MutableMap\n module HashSet\n module HashMap\n module Option\n module Result\n module Int\n module Float\n}\n```" + } +} + +Request textDocument/hover tests/lsp_tests/basic-workspace/Hover.res:285:7 +Response +{ + "contents": { + "kind": "markdown", + "value": "```rescript\ntype aliased = variant\n```\n\n---\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\n" + } +} + diff --git a/tests/lsp_tests/basic-workspace/package.json b/tests/lsp_tests/basic-workspace/package.json new file mode 100644 index 00000000000..950bea0a1f9 --- /dev/null +++ b/tests/lsp_tests/basic-workspace/package.json @@ -0,0 +1,14 @@ +{ + "name": "@tests/lsp-tests-basic-workspace", + "type": "module", + "private": true, + "scripts": { + "build": "rescript build", + "clean": "rescript clean", + "dev": "rescript -w" + }, + "dependencies": { + "@rescript/react": "workspace:^", + "rescript": "workspace:^" + } +} diff --git a/tests/lsp_tests/basic-workspace/rescript.json b/tests/lsp_tests/basic-workspace/rescript.json new file mode 100644 index 00000000000..0f6ec0f0d92 --- /dev/null +++ b/tests/lsp_tests/basic-workspace/rescript.json @@ -0,0 +1,13 @@ +{ + "name": "@tests/lsp-tests-basic-workspace", + "sources": { + "dir": "." + }, + "package-specs": { + "module": "esmodule", + "in-source": false + }, + "suffix": ".res.js", + "dependencies": ["@rescript/react"], + "jsx": { "version": 4 } +} diff --git a/tests/lsp_tests/dune b/tests/lsp_tests/dune new file mode 100644 index 00000000000..b9f23ca8eec --- /dev/null +++ b/tests/lsp_tests/dune @@ -0,0 +1,10 @@ +(executable + (name test) + (package rescript-language-server) + (public_name lsp-tests) + (libraries lsp jsonrpc yojson eio eio_main) + (flags + (-w "-9-32-33"))) + +(dirs + (:standard \ ignored_dir basic-workspace)) diff --git a/tests/lsp_tests/test.ml b/tests/lsp_tests/test.ml new file mode 100644 index 00000000000..a767ac164af --- /dev/null +++ b/tests/lsp_tests/test.ml @@ -0,0 +1,293 @@ +let ( // ) = Filename.concat +let ( / ) = Eio.Path.( / ) +let executable = "_build" // "default" // "lsp" // "bin" // "main.exe" + +module Client = struct + (** Helpers for spawning the ReScript language server in tests, sending + LSP requests/notifications over stdio, and reading responses back. *) + + type t = { + proc: [`Generic | `Unix] Eio.Process.ty Eio.Resource.t; + stdin: Eio_unix.sink_ty Eio.Resource.t; + stdout: Eio.Buf_read.t; + mutable next_id: int; + } + + let frame (json : Yojson.Safe.t) : string = + let body = Yojson.Safe.to_string json in + Printf.sprintf "Content-Length: %d\r\n\r\n%s" (String.length body) body + + let read_headers buf = + let rec loop acc = + match Eio.Buf_read.line buf with + | "" -> Some acc + | line -> + let acc = + match String.index_opt line ':' with + | None -> acc + | Some i -> + let k = String.sub line 0 i in + let v = + String.trim (String.sub line (i + 1) (String.length line - i - 1)) + in + (k, v) :: acc + in + loop acc + | exception End_of_file -> if acc = [] then None else Some acc + in + loop [] + + let read_message buf = + match read_headers buf with + | None -> None + | Some headers -> + let len = int_of_string (List.assoc "Content-Length" headers) in + let body = Eio.Buf_read.take len buf in + Some (Yojson.Safe.from_string body) + + let start ~sw ~env = + let mgr = Eio.Stdenv.process_mgr env in + let stdin_r, stdin_w = Eio_unix.pipe sw in + let stdout_r, stdout_w = Eio_unix.pipe sw in + let proc = + Eio.Process.spawn ~sw mgr ~stdin:stdin_r ~stdout:stdout_w ~executable [] + in + Eio.Resource.close stdin_r; + Eio.Resource.close stdout_w; + let stdout = Eio.Buf_read.of_flow ~max_size:(16 * 1024 * 1024) stdout_r in + {proc; stdin = stdin_w; stdout; next_id = 0} + + let send_packet t (packet : Jsonrpc.Packet.t) = + let json = Jsonrpc.Packet.yojson_of_t packet in + Eio.Flow.copy_string (frame json) t.stdin + + let next_id t = + t.next_id <- t.next_id + 1; + t.next_id + + (** Send a typed LSP request and return the assigned id. *) + let send_request t (req : 'r Lsp.Client_request.t) = + let id = `Int (next_id t) in + let jsonrpc_req = Lsp.Client_request.to_jsonrpc_request req ~id in + send_packet t (Jsonrpc.Packet.Request jsonrpc_req); + id + + (** Send a typed LSP notification. *) + let send_notification t (notif : Lsp.Client_notification.t) = + let jsonrpc_notif = Lsp.Client_notification.to_jsonrpc notif in + send_packet t (Jsonrpc.Packet.Notification jsonrpc_notif) + + (** Read packets until we find the response matching [id]. Server + notifications/requests received in the meantime are discarded. *) + let rec read_response t id = + match read_message t.stdout with + | None -> failwith "Helper.read_response: unexpected EOF" + | Some json -> ( + match Jsonrpc.Packet.t_of_yojson json with + | Response resp when resp.id = id -> resp + | _ -> read_response t id) + + (** Send a typed request and synchronously wait for its response, decoded + back into the request's result type. *) + let request (type r) t (req : r Lsp.Client_request.t) : r = + let id = send_request t req in + let resp = read_response t id in + match resp.result with + | Ok json -> Lsp.Client_request.response_of_json req json + | Error err -> failwith ("LSP error response: " ^ err.message) + + (** Read the next packet of any kind. Useful when waiting for a server + notification (e.g. publishDiagnostics). *) + (* let read_packet t = + match read_message t.stdout with + | None -> failwith "Helper.read_packet: unexpected EOF" + | Some json -> Jsonrpc.Packet.t_of_yojson json *) + + let stop t = + (try Eio.Resource.close t.stdin with _ -> ()); + Eio.Process.await t.proc + + (** Run [f] with a freshly started server, ensuring the process is stopped + and the switch is released afterwards. *) + let with_server ~env f = + Eio.Switch.run @@ fun sw -> + let t = start ~sw ~env in + Fun.protect ~finally:(fun () -> ignore (stop t)) (fun () -> f t) +end + +open Lsp +open Types + +type caret_comment = { + path: string; (* absolute path *) + line: int; (* line of the comment *) + col: int; (* column of the ^ character *) + command: string; (* e.g. "hov" *) + text: string; (* file content *) +} + +module String_map = Map.Make (String) + +let find_caret_comments ~fs ~workspace_dir = + let results = ref [] in + + (* Read all .res files in directory *) + Eio.Path.with_open_dir + Eio.Path.(fs / workspace_dir) + (fun dir_handle -> + Eio.Path.read_dir dir_handle + |> List.filter (fun file -> + String.ends_with ~suffix:".res" file + || String.ends_with ~suffix:".resi" file) + |> List.iter (fun filename -> + let path = Eio.Path.(dir_handle / filename) in + let content = Eio.Path.load path in + let lines = String.split_on_char '\n' content in + + List.iteri + (fun line_idx line -> + (* Match lines like "// ^command" *) + match String.trim line with + | s when String.length s > 3 && String.sub s 0 3 = "// " -> ( + let rest = String.sub s 3 (String.length s - 3) in + match String.index_opt rest '^' with + | None -> () + | Some caret_in_rest -> + (* Column of ^ in original line *) + let prefix_len = + String.length line - String.length (String.trim line) + in + let col = prefix_len + 3 + caret_in_rest in + let command = + let after = caret_in_rest + 1 in + if after < String.length rest then + String.trim + (String.sub rest after (String.length rest - after)) + else "" + in + results := + { + path = workspace_dir // snd path; + line = line_idx; + col; + command; + text = content; + } + :: !results) + | _ -> ()) + lines)); + + List.rev !results + +let open_document ~uri ~text client = + Client.send_notification client + (Client_notification.TextDocumentDidOpen + (DidOpenTextDocumentParams.create + ~textDocument: + (TextDocumentItem.create ~uri ~languageId:"rescript" ~version:0 + ~text))) + +let pretty_source_loc caret_comment = + let relative_path = + let dir_len = String.length (Sys.getcwd () ^ "/") in + String.sub caret_comment.path dir_len + (String.length caret_comment.path - dir_len) + in + + Printf.sprintf "%s:%d:%d" relative_path caret_comment.line + (caret_comment.col + 1) + +let send_request payload client = + let response = Client.request client payload in + Client_request.yojson_of_result payload response + |> Yojson.Safe.pretty_to_string ~std:true + +let print_response method_ response caret_comment = + Printf.sprintf "Request %s %s\nResponse\n%s\n\n" method_ + (pretty_source_loc caret_comment) + response + +let run_test_for_comment (caret_comment : caret_comment) client = + let uri = DocumentUri.of_path caret_comment.path in + let textDocument = TextDocumentIdentifier.create ~uri in + + let character = caret_comment.col in + let line = caret_comment.line - 1 in + let position = Position.create ~line ~character in + + match caret_comment.command with + | "hov" -> + let resp = + send_request + (Client_request.TextDocumentHover + (HoverParams.create ~textDocument ~position ())) + client + in + print_response "textDocument/hover" resp caret_comment + (* | "cmp" -> + let context = + CompletionContext.create ~triggerCharacter:">" + ~triggerKind:CompletionTriggerKind.TriggerCharacter () + in + send_request + (Client_request.TextDocumentCompletion + (CompletionParams.create ~textDocument ~position ~context ())) + "textDocument/completion" caret_comment *) + | other -> + Printf.sprintf "Command `%s` not implemented! %s\n\n" other + (pretty_source_loc caret_comment) + +let run_workspace_test ~fs ~workspace_dir client = + let comments = find_caret_comments ~fs ~workspace_dir in + + let grouped = + List.fold_left + (fun acc comment -> + let others = + Option.value ~default:[] (String_map.find_opt comment.path acc) + in + String_map.add comment.path (comment :: others) acc) + String_map.empty comments + in + + String_map.iter + (fun path comments -> + let hd = comments |> List.hd in + let uri = DocumentUri.of_path hd.path in + let text = hd.text in + + open_document ~uri ~text client; + + let filename = Filename.basename path ^ ".expected" in + let save_path = workspace_dir // filename in + let content = + List.rev_map (fun c -> run_test_for_comment c client) comments + |> String.concat "" + in + let file = Eio.Path.(fs / save_path) in + Eio.Path.save ~create:(`Or_truncate 0o644) file content) + grouped + +let client_capabilities = ClientCapabilities.create () + +let main () = + let workspace_dir = + Sys.getcwd () // "tests" // "lsp_tests" // "basic-workspace" + in + Eio_main.run @@ fun env -> + Client.with_server ~env @@ fun client -> + let id = + Client.send_request client + (Client_request.Initialize + (InitializeParams.create ~capabilities:client_capabilities + ~rootUri:(DocumentUri.of_path workspace_dir) + ())) + in + (* Assert than server capabilities return is ok *) + assert ((Client.read_response client id).result |> Result.is_ok); + let () = Client.send_notification client Client_notification.Initialized in + + run_workspace_test ~fs:env#fs ~workspace_dir client; + Client.stop client |> ignore + +let () = main () diff --git a/yarn.lock b/yarn.lock index 28f8cabcdcd..9433dd4ce8b 100644 --- a/yarn.lock +++ b/yarn.lock @@ -939,6 +939,15 @@ __metadata: languageName: unknown linkType: soft +"@tests/lsp-tests-basic-workspace@workspace:tests/lsp_tests/basic-workspace": + version: 0.0.0-use.local + resolution: "@tests/lsp-tests-basic-workspace@workspace:tests/lsp_tests/basic-workspace" + dependencies: + "@rescript/react": "workspace:^" + rescript: "workspace:^" + languageName: unknown + linkType: soft + "@tests/namespaced-references@workspace:tests/analysis_tests/tests-namespaced-references": version: 0.0.0-use.local resolution: "@tests/namespaced-references@workspace:tests/analysis_tests/tests-namespaced-references"