diff --git a/CHANGELOG.md b/CHANGELOG.md index cd9c34f1a..615b6fe0f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ - Make it a warning if ocamlc is missing (#1642) - Add `1.18.0`, `1.19.0` and `1.20.0~5.3preview` to the list of known versions of ocamllsp (#1644) +- Add `ocaml.construct` to construct an expression from a typedhole. (#1646) ## 1.20.1 diff --git a/package.json b/package.json index 920635f87..667803ac1 100644 --- a/package.json +++ b/package.json @@ -252,6 +252,11 @@ "command": "ocaml.copy-type-under-cursor", "category": "OCaml", "title": "Copy Type Under Cursor" + }, + { + "command": "ocaml.construct", + "category": "OCaml", + "title": "List values that can fill the selected typed-hole" } ], "configuration": { @@ -714,12 +719,12 @@ "when": "editorLangId == ocaml || editorLangId == reason" }, { - "command": "editor.action.codeAction", + "command": "ocaml.construct", "key": "Alt+C", "args": { "kind": "construct" }, - "when": "editorLangId == ocaml" + "when": "editorLangId == ocaml || editorLangId == reason" }, { "command": "editor.action.codeAction", @@ -1040,6 +1045,10 @@ { "command": "ocaml.copy-type-under-cursor", "when": "editorLangId == ocaml || editorLangId == ocaml.interface || editorLangId == reason || editorLangId == ocaml.ocamllex" + }, + { + "command": "ocaml.construct", + "when": "editorLangId == ocaml || editorLangId == ocaml.interface || editorLangId == reason || editorLangId == ocaml.ocamllex" } ], "editor/title": [ diff --git a/src/custom_requests.ml b/src/custom_requests.ml index e30b7a1a6..2f82586a9 100644 --- a/src/custom_requests.ml +++ b/src/custom_requests.ml @@ -73,3 +73,50 @@ module Type_enclosing = struct let request = { meth = ocamllsp_prefixed "typeEnclosing"; encode_params; decode_response } end + +module Construct = struct + type params = + { uri : Uri.t + ; position : Position.t + ; depth : int option + ; with_values : [ `None | `Local ] option + } + + type response = + { position : Range.t + ; result : string list + } + + let encode_params { uri; position; depth; with_values } = + let open Jsonoo.Encode in + let uri = ("uri", string @@ Uri.toString uri ()) in + let position = ("position", Position.json_of_t position) in + let depth = + ("depth", Option.(value ~default:null (map ~f:(fun d -> int d) depth))) + in + let with_values = + ( "with_values" + , Option.( + value + ~default:null + (map + ~f:(fun w -> + match w with + | `None -> string "none" + | `Local -> string "local") + with_values)) ) + in + object_ [ uri; position; depth; with_values ] + + let decode_response response = + let open Jsonoo.Decode in + let position = field "position" Range.t_of_json response in + let result = field "result" (list string) response in + { position; result } + + let make ~uri ~position ?(depth = None) ?(with_values = None) () = + { uri; position; depth; with_values } + + let request = + { meth = ocamllsp_prefixed "construct"; encode_params; decode_response } +end diff --git a/src/custom_requests.mli b/src/custom_requests.mli index 216530c41..d16a24494 100644 --- a/src/custom_requests.mli +++ b/src/custom_requests.mli @@ -39,3 +39,22 @@ module Type_enclosing : sig val request : (params, response) custom_request end + +module Construct : sig + type params + + type response = + { position : Range.t + ; result : string list + } + + val make : + uri:Uri.t + -> position:Position.t + -> ?depth:int option + -> ?with_values:[ `None | `Local ] option + -> unit + -> params + + val request : (params, response) custom_request +end diff --git a/src/extension_commands.ml b/src/extension_commands.ml index dd5db80f4..35175ec8d 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -164,6 +164,13 @@ module Holes_commands : sig val _jump_to_prev_hole : t val _jump_to_next_hole : t + + val closest_hole : + Position.t + -> TextEditor.t + -> LanguageClient.t + -> [< `Next | `Prev ] + -> Range.t option Promise.t end = struct let hole_not_found_msg = "No typed hole was found in this file" @@ -199,6 +206,11 @@ end = struct ~revealType:TextEditorRevealType.InCenterIfOutsideViewport () + let send_request_to_lsp client text_editor = + let doc = TextEditor.document text_editor in + let uri = TextDocument.uri doc in + Custom_requests.send_request client Custom_requests.typedHoles uri + let jump_to_hole jump (instance : Extension_instance.t) ~args = (* this command is available (in the command palette) only when a file is open *) @@ -216,12 +228,8 @@ end = struct when not (Ocaml_lsp.can_handle_typed_holes ocaml_lsp) -> ocaml_lsp_doesn't_support_holes instance ocaml_lsp | Some (client, _ocaml_lsp) -> - let doc = TextEditor.document text_editor in - let uri = TextDocument.uri doc in let (_ : unit Promise.t) = - let+ holes = - Custom_requests.send_request client Custom_requests.typedHoles uri - in + let+ holes = send_request_to_lsp client text_editor in jump ~cmd_args:args text_editor @@ -365,6 +373,21 @@ end = struct select_hole_range text_editor hole)) end + let closest_hole position text_editor client direction = + (* We aren't checking if there's the capability to handle typed holes *) + let open Promise.Syntax in + let+ holes = send_request_to_lsp client text_editor in + let sorted_holes = List.sort holes ~compare:Range.compare in + match sorted_holes with + | [] -> None + | holes -> + Some + (match direction with + | `Prev -> + Prev_hole.pick_prev_hole position ~sorted_non_empty_holes_list:holes + | `Next -> + Next_hole.pick_next_hole position ~sorted_non_empty_holes_list:holes) + let _jump_to_next_hole = command Extension_consts.Commands.next_hole (jump_to_hole Next_hole.jump) @@ -536,6 +559,111 @@ module Copy_type_under_cursor = struct command Extension_consts.Commands.copy_type_under_cursor handler end +module Construct = struct + let extension_name = "Construct" + + let is_valid_text_doc textdoc = + match TextDocument.languageId textdoc with + | "ocaml" | "ocaml.interface" | "reason" | "ocaml.ocamllex" -> true + | _ -> false + + let ocaml_lsp_doesnt_support_construct ocaml_lsp = + not (Ocaml_lsp.can_handle_construct ocaml_lsp) + + let get_construct_results position text_editor client = + let doc = TextEditor.document text_editor in + let uri = TextDocument.uri doc in + Custom_requests.( + send_request + client + Construct.request + (Construct.make ~uri ~position ~depth:None ~with_values:None ())) + + let display_results (results : Custom_requests.Construct.response) = + let quickPickItems = + List.map results.result ~f:(fun res -> + (QuickPickItem.create ~label:res (), (res, results.position))) + in + let quickPickOptions = + QuickPickOptions.create ~title:"Construct results" () + in + Window.showQuickPickItems + ~choices:quickPickItems + ~options:quickPickOptions + () + + let insert_to_document text_editor range value = + TextEditor.edit + text_editor + ~callback:(fun ~editBuilder -> + Vscode.TextEditorEdit.replace + editBuilder + ~location:(`Range range) + ~value) + () + + let rec process_construct position text_editor client instance = + let open Promise.Syntax in + let* res = get_construct_results position text_editor client in + let* selected_result = display_results res in + match selected_result with + | Some (value, range) -> ( + let* value_inserted = insert_to_document text_editor range value in + match value_inserted with + | true -> ( + let* new_range = + Holes_commands.closest_hole + (Range.start range) + text_editor + client + `Next + in + match new_range with + | Some range -> + process_construct (Range.end_ range) text_editor client instance + | None -> Promise.return ()) + | false -> Promise.return ()) + | None -> Promise.return () + + let _construct = + let handler (instance : Extension_instance.t) ~args:_ = + let construct () = + match Window.activeTextEditor () with + | None -> + Extension_consts.Command_errors.text_editor_must_be_active + extension_name + ~expl: + "The cursor position is used to determine the correct \ + environment and insert the result." + |> show_message `Error "%s" + | Some text_editor + when not (is_valid_text_doc (TextEditor.document text_editor)) -> + show_message + `Error + "Invalid file type. This command only works in ocaml files, ocaml \ + interface files, reason files or ocamllex files." + | Some text_editor -> ( + match Extension_instance.lsp_client instance with + | None -> show_message `Warn "ocamllsp is not running" + | Some (_client, ocaml_lsp) + when ocaml_lsp_doesnt_support_construct ocaml_lsp -> + show_message + `Warn + "The installed version of `ocamllsp` does not support construct \ + custom requests" + | Some (client, _) -> + let position = + TextEditor.selection text_editor |> Selection.active + in + let _ = process_construct position text_editor client instance in + ()) + in + let (_ : unit) = construct () in + () + in + command Extension_consts.Commands.construct handler +end + let register extension instance = function | Command { id; handler } -> let callback = handler instance in diff --git a/src/extension_consts.ml b/src/extension_consts.ml index 6c16f51f0..c733e0d57 100644 --- a/src/extension_consts.ml +++ b/src/extension_consts.ml @@ -68,6 +68,8 @@ module Commands = struct let ask_debug_program = ocaml_prefixed "ask-debug-program" let copy_type_under_cursor = ocaml_prefixed "copy-type-under-cursor" + + let construct = ocaml_prefixed "construct" end module Command_errors = struct diff --git a/src/ocaml_lsp.ml b/src/ocaml_lsp.ml index a8c3fc940..2df48621c 100644 --- a/src/ocaml_lsp.ml +++ b/src/ocaml_lsp.ml @@ -44,6 +44,7 @@ module Experimental_capabilities = struct ; handleInferIntf : bool ; handleTypedHoles : bool ; handleTypeEnclosing : bool + ; handleConstruct : bool } let default = @@ -51,6 +52,7 @@ module Experimental_capabilities = struct ; handleInferIntf = false ; handleTypedHoles = false ; handleTypeEnclosing = false + ; handleConstruct = false } (** Creates [t] given a JSON of form [{ 'handleSwitchImplIntf' : true, .... }] *) @@ -65,10 +67,12 @@ module Experimental_capabilities = struct let handleInferIntf = has_capability "handleInferIntf" in let handleTypedHoles = has_capability "handleTypedHoles" in let handleTypeEnclosing = has_capability "handleTypeEnclosing" in + let handleConstruct = has_capability "handleConstruct" in { handleSwitchImplIntf ; handleInferIntf ; handleTypedHoles ; handleTypeEnclosing + ; handleConstruct } with Jsonoo.Decode_error err -> show_message @@ -236,3 +240,5 @@ let can_handle_typed_holes t = t.experimental_capabilities.handleTypedHoles let can_handle_type_enclosing t = t.experimental_capabilities.handleTypeEnclosing + +let can_handle_construct t = t.experimental_capabilities.handleConstruct diff --git a/src/ocaml_lsp.mli b/src/ocaml_lsp.mli index 65754abb3..6f59c721d 100644 --- a/src/ocaml_lsp.mli +++ b/src/ocaml_lsp.mli @@ -15,6 +15,8 @@ val can_handle_typed_holes : t -> bool val can_handle_type_enclosing : t -> bool +val can_handle_construct : t -> bool + module OcamllspSettingEnable : sig include Ojs.T diff --git a/src/treeview_commands.ml b/src/treeview_commands.ml index d4164b6df..77b9b73be 100644 --- a/src/treeview_commands.ml +++ b/src/treeview_commands.ml @@ -43,7 +43,23 @@ let terminal_item = Vscode.TreeItem.set_command item command; item -let items = [ select_sandbox_item; terminal_item ] +let construct_item = + let icon = `ThemeIcon (Vscode.ThemeIcon.make ~id:"tools" ()) in + let label = + `TreeItemLabel + (Vscode.TreeItemLabel.create + ~label:"List values that can fill the selected typed-hole" + ()) + in + let item = Vscode.TreeItem.make_label ~label () in + let command = + Vscode.Command.create ~title:"Construct" ~command:"ocaml.construct" () + in + Vscode.TreeItem.set_iconPath item icon; + Vscode.TreeItem.set_command item command; + item + +let items = [ select_sandbox_item; terminal_item; construct_item ] let getTreeItem ~element = `Value element diff --git a/yarn.lock b/yarn.lock index e8c989d95..d4ded5345 100644 --- a/yarn.lock +++ b/yarn.lock @@ -2645,9 +2645,9 @@ __metadata: linkType: hard "electron-to-chromium@npm:^1.5.41": - version: 1.5.57 - resolution: "electron-to-chromium@npm:1.5.57" - checksum: 10c0/42b969681985016be6069ae68cf29e84ba3f2191fcb7f9d3355e83e81da8dbd100e4b5c9d69b88637003e06dc1860125a50332ec0caee49fd9c2c4ab62feb288 + version: 1.5.60 + resolution: "electron-to-chromium@npm:1.5.60" + checksum: 10c0/934d8d1383ffee4f5f94586ebf0afd133c841002fa3b3cc60b8f6c2af62cd1a73b40cf9fd4cfabba854c3ea5f1df0ecb69f0f9d2e3f913e6b7df7461685b4955 languageName: node linkType: hard