%s" file_content) 61 | | Error e -> 62 | let uri = Cm_document.uri document in 63 | let path = Uri.path uri in 64 | let file_name = Node.Path.basename path in 65 | let (_ : 'a option Promise.t) = 66 | Window.showErrorMessage 67 | ~message: 68 | (Printf.sprintf 69 | "Error while trying to read content from %s file. %s" 70 | file_name 71 | e) 72 | () 73 | in 74 | () 75 | in 76 | let (_ : unit) = 77 | Cm_document.onDidChange 78 | document 79 | ~listener:(fun () -> 80 | let (_ : unit Promise.t) = update_content document in 81 | ()) 82 | () 83 | |> Stack.push disposables 84 | in 85 | let (_ : unit) = 86 | WebviewPanel.onDidDispose 87 | webviewPanel 88 | ~listener:(fun () -> 89 | Disposable.from (Stack.to_list disposables) |> Disposable.dispose) 90 | () 91 | |> Stack.push disposables 92 | in 93 | update_content document 94 | ;; 95 | 96 | let openCustomDocument ~(uri : Uri.t) ~openContext:_ ~token:_ : Cm_document.t Promise.t = 97 | let document = Cm_document.create ~uri in 98 | Promise.resolve document 99 | ;; 100 | 101 | let register (extension : ExtensionContext.t) (instance : Extension_instance.t) = 102 | let module CustomReadonlyEditorProvider = CustomReadonlyEditorProvider.Make (Cm_document) 103 | in 104 | let editorProvider = 105 | CustomReadonlyEditorProvider.create 106 | ~resolveCustomEditor:(resolveCustomEditor instance) 107 | ~openCustomDocument 108 | in 109 | let disposable = 110 | Vscode.Window.registerCustomReadonlyEditorProvider 111 | (module Cm_document) 112 | ~viewType:"cm-files-editor" 113 | ~provider:editorProvider 114 | ~options: 115 | (Vscode.RegisterCustomEditorProviderOptions.create 116 | ~supportsMultipleEditorsPerDocument:true 117 | ()) 118 | () 119 | in 120 | Vscode.ExtensionContext.subscribe extension ~disposable 121 | ;; 122 | -------------------------------------------------------------------------------- /src/cm_editor.mli: -------------------------------------------------------------------------------- 1 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 2 | -------------------------------------------------------------------------------- /src/cmd.mli: -------------------------------------------------------------------------------- 1 | (** Interface for running system commands *) 2 | 3 | open Import 4 | 5 | type spawn = 6 | { bin : Path.t 7 | ; args : string list 8 | } 9 | 10 | type t = 11 | | Shell of string 12 | | Spawn of spawn 13 | 14 | type stdout = string 15 | type stderr = string 16 | 17 | (* surround a string with quotes if it has spaces *) 18 | val quote : string -> string 19 | val to_spawn : t -> spawn 20 | val append : spawn -> string list -> spawn 21 | val check_spawn : ?env:string Interop.Dict.t -> spawn -> spawn Or_error.t Promise.t 22 | val check : ?env:string Interop.Dict.t -> t -> t Or_error.t Promise.t 23 | val log : ?result:ChildProcess.return -> t -> unit 24 | 25 | val output 26 | : ?cwd:Path.t 27 | -> ?env:string Interop.Dict.t 28 | -> ?stdin:string 29 | -> t 30 | -> (stdout, stderr) result Promise.t 31 | 32 | val equal_spawn : spawn -> spawn -> bool 33 | 34 | val run 35 | : ?cwd:Path.t 36 | -> ?env:string Interop.Dict.t 37 | -> ?stdin:stderr 38 | -> t 39 | -> ChildProcess.return Promise.t 40 | -------------------------------------------------------------------------------- /src/custom_requests.mli: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | (** Module to include custom requests to the language server, i.e., requests 4 | that are not originally in LSP but are customly added by a specific language 5 | server. 6 | 7 | If you want to add support for a custom request, add [custom_request] for 8 | the custom request to the implementation of this module. *) 9 | 10 | type ('params, 'response) custom_request 11 | 12 | val send_request 13 | : LanguageClient.t 14 | -> ('params, 'resp) custom_request 15 | -> 'params 16 | -> 'resp Promise.t 17 | 18 | val switchImplIntf : (string, string array) custom_request 19 | val inferIntf : (string, string) custom_request 20 | val typedHoles : (Uri.t, Range.t list) custom_request 21 | 22 | module Type_selection : sig 23 | type params 24 | 25 | type response = 26 | { index : int 27 | ; type_ : string 28 | ; enclosings : Range.t array 29 | } 30 | 31 | val make 32 | : uri:Uri.t 33 | -> at:[ `Position of Position.t | `Range of Range.t ] 34 | -> index:int 35 | -> verbosity:int 36 | -> params 37 | 38 | val request : (params, response) custom_request 39 | end 40 | 41 | module Construct : sig 42 | type params 43 | 44 | type response = 45 | { position : Range.t 46 | ; result : string list 47 | } 48 | 49 | val make 50 | : uri:Uri.t 51 | -> position:Position.t 52 | -> ?depth:int option 53 | -> ?with_values:[ `None | `Local ] option 54 | -> unit 55 | -> params 56 | 57 | val request : (params, response) custom_request 58 | end 59 | 60 | module Merlin_jump : sig 61 | type params 62 | type response = (string * Position.t) list 63 | 64 | val make : uri:Uri.t -> position:Position.t -> params 65 | val request : (params, response) custom_request 66 | end 67 | 68 | module Type_search : sig 69 | type type_search_result = 70 | { name : string 71 | ; typ : string 72 | ; loc : Range.t 73 | ; doc : MarkupContent.t option 74 | ; cost : int 75 | ; constructible : string 76 | } 77 | 78 | type params 79 | type response = type_search_result list 80 | 81 | val make 82 | : uri:Uri.t 83 | -> position:Position.t 84 | -> limit:int 85 | -> query:string 86 | -> with_doc:bool 87 | -> ?doc_format:MarkupKind.t option 88 | -> unit 89 | -> params 90 | 91 | val request : (params, response) custom_request 92 | end 93 | -------------------------------------------------------------------------------- /src/documentation_server.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | type t' = 4 | { server : Polka.Server.t 5 | ; path : Path.t 6 | } 7 | 8 | type t = t' option ref 9 | 10 | let start ~path = 11 | Promise.make 12 | @@ fun ~resolve ~reject:_ -> 13 | let polka = Polka.create () in 14 | let options = Polka.Sirv.Options.create ~dev:true in 15 | let serve = 16 | polka 17 | |> Polka.use [ Polka.Sirv.serve (path |> Path.to_string) ~options () ] 18 | |> Polka.listen 0 ~hostname:"localhost" ~callback:(fun () -> 19 | let server = Polka.server polka in 20 | resolve (Ok (ref (Some { server; path })))) 21 | in 22 | let polka = serve () in 23 | let server = Polka.server polka in 24 | Polka.Server.on server (`Error (fun ~err -> resolve (Error err))) 25 | ;; 26 | 27 | let get (t : t) = 28 | match !t with 29 | | None -> failwith "document server: already disposed" 30 | | Some t -> t 31 | ;; 32 | 33 | let path (t : t) = (get t).path 34 | 35 | let address t = 36 | match Polka.Server.address (get t).server with 37 | | None -> 38 | (* if it's [None], server must not be listening, but we aim to have server 39 | only if it's listening *) 40 | assert false 41 | | Some a -> a 42 | ;; 43 | 44 | let port t = Polka.Server.Address.port (address t) 45 | let host t = Polka.Server.Address.address (address t) 46 | 47 | let dispose (t : t) = 48 | match !t with 49 | | None -> Disposable.make ~dispose:(fun () -> ()) 50 | | Some server -> 51 | t := None; 52 | Disposable.make ~dispose:(fun () -> 53 | let (_ : Polka.Server.t) = 54 | Polka.Server.close 55 | server.server 56 | ~callback:(fun error -> 57 | match error with 58 | | None -> () 59 | | Some error -> 60 | show_message 61 | `Warn 62 | "Error closing server: %s" 63 | (Ojs.string_of_js (Promise.error_to_js error))) 64 | () 65 | in 66 | ()) 67 | ;; 68 | -------------------------------------------------------------------------------- /src/documentation_server.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val start : path:Path.t -> (t, Node.JsError.t) result Promise.t 4 | val path : t -> Path.t 5 | val port : t -> int 6 | val host : t -> string 7 | val dispose : t -> Vscode.Disposable.t 8 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name vscode_ocaml_platform) 3 | (preprocess 4 | (pps gen_js_api.ppx)) 5 | (libraries 6 | base 7 | gen_js_api 8 | js_of_ocaml 9 | jsonoo 10 | node 11 | ocaml-version 12 | opam-file-format 13 | polka 14 | promise_jsoo 15 | vscode 16 | vscode_languageclient 17 | ppxlib 18 | ppx_tools) 19 | (modes js)) 20 | -------------------------------------------------------------------------------- /src/dune_formatter.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | let get_formatter instance ~document ~options:_ ~token:_ = 4 | let endLine = TextDocument.lineCount document - 1 in 5 | let endCharacter = 6 | TextDocument.lineAt document ~line:endLine |> TextLine.text |> String.length 7 | in 8 | (* selects entire document range *) 9 | let range = 10 | Range.makeCoordinates ~startLine:0 ~startCharacter:0 ~endLine ~endCharacter 11 | in 12 | (* text of entire document *) 13 | let document_text = TextDocument.getText document ~range () in 14 | let command = 15 | let sandbox = Extension_instance.sandbox instance in 16 | Sandbox.get_command sandbox "dune" [ "format-dune-file" ] 17 | in 18 | let output = 19 | let open Promise.Result.Syntax in 20 | let* command = Cmd.check command in 21 | Cmd.output ~stdin:document_text command 22 | in 23 | let promise = 24 | let open Promise.Syntax in 25 | let+ output = output in 26 | match output with 27 | | Ok newText -> Some [ TextEdit.replace ~range ~newText ] 28 | | Error msg -> 29 | show_message `Error "Dune formatting failed: %s" msg; 30 | Some [] 31 | in 32 | `Promise promise 33 | ;; 34 | 35 | let register extension instance = 36 | [ "dune"; "dune-project"; "dune-workspace" ] 37 | |> List.map ~f:(fun language -> 38 | let selector = `Filter (DocumentFilter.create ~scheme:"file" ~language ()) in 39 | let provider = 40 | DocumentFormattingEditProvider.create 41 | ~provideDocumentFormattingEdits:(get_formatter instance) 42 | in 43 | Languages.registerDocumentFormattingEditProvider ~selector ~provider) 44 | |> List.iter ~f:(fun disposable -> ExtensionContext.subscribe extension ~disposable) 45 | ;; 46 | -------------------------------------------------------------------------------- /src/dune_formatter.mli: -------------------------------------------------------------------------------- 1 | (** register formatters for dune, dune-project, and dune-workspace files; takes 2 | care of subscribing of the disposable to the execution context *) 3 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 4 | -------------------------------------------------------------------------------- /src/dune_task_provider.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | let task_type = "dune" 4 | let definition = TaskDefinition.create ~type_:task_type () 5 | let source = task_type 6 | let problemMatchers = [ "$ocamlc" ] 7 | 8 | (* the ocamlc matcher is not able to parse ocaml compiler errors unless they 9 | follow the short style. *) 10 | let env = Interop.Dict.of_alist [ "OCAML_ERROR_STYLE", "short" ] 11 | 12 | module Setting = struct 13 | type t = bool 14 | 15 | let of_json json = 16 | let open Jsonoo.Decode in 17 | bool json 18 | ;; 19 | 20 | let to_json (t : t) = 21 | let open Jsonoo.Encode in 22 | bool t 23 | ;; 24 | 25 | let t = 26 | Settings.create_setting ~scope:Workspace ~key:"dune.autoDetect" ~of_json ~to_json 27 | ;; 28 | end 29 | 30 | let folder_relative_path folders file = 31 | List.fold_left ~init:None folders ~f:(fun acc (folder : WorkspaceFolder.t) -> 32 | match acc with 33 | | Some _ -> acc 34 | | None -> 35 | let prefix = Uri.fsPath (WorkspaceFolder.uri folder) in 36 | (match String.chop_prefix file ~prefix with 37 | | None -> acc 38 | | Some without_prefix -> Some (folder, without_prefix))) 39 | ;; 40 | 41 | let get_shell_execution sandbox options = 42 | let command = Sandbox.get_command sandbox "dune" [ "build" ] in 43 | Cmd.log command; 44 | match command with 45 | | Shell commandLine -> ShellExecution.makeCommandLine ~commandLine ~options () 46 | | Spawn { bin; args } -> 47 | let command = `String (Path.to_string bin) in 48 | let args = List.map ~f:(fun a -> `String a) args in 49 | ShellExecution.makeCommandArgs ~command ~args ~options () 50 | ;; 51 | 52 | let compute_tasks token sandbox = 53 | let open Promise.Syntax in 54 | let folders = Workspace.workspaceFolders () in 55 | let excludes = 56 | (* ignoring dune files from _build, _opam, _esy *) 57 | `String "{**/_*}" 58 | in 59 | let includes = `String "**/{dune,dune-project,dune-workspace}" in 60 | let+ dunes = Workspace.findFiles ~includes ~excludes ~token () in 61 | let tasks = 62 | List.map dunes ~f:(fun dune -> 63 | let scope, relative_path = 64 | match folder_relative_path folders (Uri.fsPath dune) with 65 | | None -> TaskScope.Workspace, Uri.fsPath dune 66 | | Some (folder, relative_path) -> TaskScope.Folder folder, relative_path 67 | in 68 | let name = Printf.sprintf "build %s" relative_path in 69 | let execution = 70 | let cwd = Stdlib.Filename.dirname (Uri.fsPath dune) in 71 | let options = ShellExecutionOptions.create ~env ~cwd () in 72 | get_shell_execution sandbox options 73 | in 74 | let task = 75 | Task.make 76 | ~definition 77 | ~scope 78 | ~source 79 | ~name 80 | ~problemMatchers 81 | ~execution:(`ShellExecution execution) 82 | () 83 | in 84 | Task.set_group task TaskGroup.build; 85 | task) 86 | in 87 | Some tasks 88 | ;; 89 | 90 | let provide_tasks instance ~token = 91 | match Settings.get ~section:"ocaml" Setting.t with 92 | | None | Some false -> `Promise (Promise.return None) 93 | | Some true -> 94 | let sandbox = Extension_instance.sandbox instance in 95 | `Promise (compute_tasks token sandbox) 96 | ;; 97 | 98 | let resolve_task ~task ~token:_ = `Value (Some task) 99 | 100 | let register extension instance = 101 | let provideTasks = provide_tasks instance in 102 | let resolveTask = resolve_task in 103 | let provider = TaskProvider.Default.create ~provideTasks ~resolveTask in 104 | let disposable = Tasks.registerTaskProvider ~type_:task_type ~provider in 105 | ExtensionContext.subscribe extension ~disposable 106 | ;; 107 | -------------------------------------------------------------------------------- /src/dune_task_provider.mli: -------------------------------------------------------------------------------- 1 | (** Basic TaskProvider for dune. 2 | 3 | This provider creates one task per dune, dune-project, dune-workspace, file 4 | that it can find in the workspace. It doesn't parse the dune files. *) 5 | 6 | (** registers dune task provider within the vscode task providers; takes care of 7 | subscribing the disposable to the extension context *) 8 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 9 | -------------------------------------------------------------------------------- /src/earlybird.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | module VariableGetClosureCodeLocation = struct 4 | let command = "variableGetClosureCodeLocation" 5 | 6 | module Args = struct 7 | type t = { handle : int } [@@js] 8 | end 9 | 10 | module Result = struct 11 | type position = int * int [@@js] 12 | 13 | let position_to_vscode (line, character) = 14 | Position.make ~line:(line - 1) ~character:(character - 1) 15 | ;; 16 | 17 | type range = 18 | { source : string 19 | ; pos : position 20 | ; end_ : position [@js "end_"] 21 | } 22 | [@@js] 23 | 24 | let range_to_vscode { pos; end_; _ } = 25 | let start = position_to_vscode pos in 26 | let end_ = position_to_vscode end_ in 27 | Range.makePositions ~start ~end_ 28 | ;; 29 | 30 | type t = { location : range option } [@@js] 31 | end 32 | end 33 | 34 | let debugType = Extension_consts.Debuggers.earlybird 35 | 36 | let check_earlybird_available sandbox = 37 | let earlybird_help = 38 | (* earlybird <= 1.1.0 doesn't have --version *) 39 | Sandbox.get_command sandbox "ocamlearlybird" [ "--help" ] 40 | in 41 | Cmd.output earlybird_help 42 | |> Promise.Result.fold 43 | ~ok:(fun (_ : string) -> ()) 44 | ~error:(fun (_ : string) -> 45 | "Debugging failed: `earlybird` is not installed in the current sandbox.\n\n\ 46 | Hint: $ opam install earlybird") 47 | ;; 48 | 49 | let createDebugAdapterDescriptor ~instance ~session:_ ~executable:_ = 50 | let sandbox = Extension_instance.sandbox instance in 51 | let promise = 52 | let open Promise.Syntax in 53 | let* res = check_earlybird_available sandbox in 54 | match res with 55 | | Ok () -> 56 | let command = Sandbox.get_command sandbox "ocamlearlybird" [ "debug" ] in 57 | let { Cmd.bin; args } = Cmd.to_spawn command in 58 | let result = DebugAdapterExecutable.make ~command:(Path.to_string bin) ~args () in 59 | Promise.return (Some (`Executable result)) 60 | | Error s -> Promise.reject (Ojs.string_to_js s) 61 | in 62 | `Promise promise 63 | ;; 64 | 65 | let register extension instance = 66 | let createDebugAdapterDescriptor = createDebugAdapterDescriptor ~instance in 67 | let factory = DebugAdapterDescriptorFactory.create ~createDebugAdapterDescriptor in 68 | let disposable = Debug.registerDebugAdapterDescriptorFactory ~debugType ~factory in 69 | ExtensionContext.subscribe extension ~disposable; 70 | let callback ~args:_ = 71 | let open Promise.Syntax in 72 | let defaultUri = 73 | Option.map (Workspace.rootPath ()) ~f:(fun path -> Uri.parse path ()) 74 | in 75 | let filters = Interop.Dict.singleton "OCaml Bytecode Executable" [ "bc" ] in 76 | let options = 77 | OpenDialogOptions.create 78 | ~canSelectFiles:true 79 | ~canSelectFolders:false 80 | ~canSelectMany:false 81 | ?defaultUri 82 | ~filters 83 | ~openLabel:"Debug" 84 | ~title:"OCaml earlybird (experimental)" 85 | () 86 | in 87 | let result = 88 | let+ uri = Window.showOpenDialog ~options () in 89 | match uri with 90 | | Some [ uri ] -> Some (Uri.fsPath uri) 91 | | _ -> None 92 | in 93 | [%js.of: string option Promise.t] result 94 | in 95 | let disposable = 96 | Commands.registerCommandReturn 97 | ~command:Extension_consts.Commands.ask_debug_program 98 | ~callback 99 | in 100 | ExtensionContext.subscribe extension ~disposable 101 | ;; 102 | -------------------------------------------------------------------------------- /src/earlybird.mli: -------------------------------------------------------------------------------- 1 | module VariableGetClosureCodeLocation : sig 2 | val command : string 3 | 4 | module Args : sig 5 | type t = { handle : int } 6 | 7 | val t_to_js : t -> Ojs.t 8 | end 9 | 10 | module Result : sig 11 | type position 12 | 13 | type range = 14 | { source : string 15 | ; pos : position 16 | ; end_ : position 17 | } 18 | 19 | val range_to_vscode : range -> Vscode.Range.t 20 | 21 | type t = { location : range option } 22 | 23 | val t_of_js : Ojs.t -> t 24 | end 25 | end 26 | 27 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 28 | -------------------------------------------------------------------------------- /src/esy.mli: -------------------------------------------------------------------------------- 1 | (** Provide an interface to Esy. 2 | 3 | The functions in this module either use the result of esy commands, or use 4 | the filesystem to get the state of esy configurations. *) 5 | 6 | open Import 7 | 8 | module Manifest : sig 9 | type t 10 | 11 | val equal : t -> t -> bool 12 | val path : t -> Path.t 13 | val of_path : Path.t -> t 14 | end 15 | 16 | (** A package installed in an Esy sandbox *) 17 | module Package : sig 18 | type t 19 | 20 | (** {4 Properties} *) 21 | 22 | val name : t -> string 23 | val version : t -> string 24 | val documentation : t -> string option 25 | val synopsis : t -> string option 26 | val has_dependencies : t -> bool 27 | val dependencies : t -> (t list, string) result Promise.t 28 | end 29 | 30 | type t 31 | 32 | val make : unit -> t option Promise.t 33 | 34 | type discover = 35 | { manifest : Manifest.t 36 | ; status : (unit, string) result 37 | } 38 | 39 | val discover : dir:Path.t -> discover list Promise.t 40 | val find_manifest_in_dir : Path.t -> Manifest.t option Promise.t 41 | val setup_sandbox : t -> Manifest.t -> unit Or_error.t Promise.t 42 | 43 | (** {4 Working with packages} *) 44 | 45 | (** Return the list of installed packages in the given opam switch. *) 46 | val packages : t -> Manifest.t -> (Package.t list, string) result Promise.t 47 | 48 | (** Return the list of root packages in the given opam switch. 49 | 50 | Root packages are packages that have been installed by the user, as opposed 51 | to packages that have been installed as a dependency of another package. *) 52 | val root_packages : t -> Manifest.t -> (Package.t list, string) result Promise.t 53 | 54 | (** Install a package in the Esy sandbox. *) 55 | val install : t -> Manifest.t -> packages:string list -> Cmd.t 56 | 57 | (** {4 General utilities} *) 58 | 59 | (** Execute an esy sub-command with in the given sandbox. *) 60 | val exec : t -> Manifest.t -> args:string list -> Cmd.t 61 | 62 | (** Check that two instances of [Esy] are equal. *) 63 | val equal : t -> t -> bool 64 | -------------------------------------------------------------------------------- /src/extension_commands.mli: -------------------------------------------------------------------------------- 1 | (** Module to manage commands[1] across the extension. 2 | 3 | Module does not have public API for command creation on purpose. One should 4 | only create new commands in [extension_commands.ml] using [command] function 5 | and expose them here if they want to. 6 | 7 | All commands are registered using [register_all_commands] in 8 | [Vscode_ocaml_platform.activate]. 9 | 10 | [1] https://code.visualstudio.com/api/references/vscode-api#commands *) 11 | 12 | (** Registers commands with vscode. Should be called in 13 | [Vscode_ocaml_platform.activate]. It subscribes the disposables to the 14 | extension context provided. *) 15 | val register_all_commands : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 16 | 17 | val register : id:string -> (Extension_instance.t -> args:Ojs.t list -> unit) -> unit 18 | 19 | val register_text_editor 20 | : id:string 21 | -> (Extension_instance.t 22 | -> textEditor:Vscode.TextEditor.t 23 | -> edit:Vscode.TextEditorEdit.t 24 | -> args:Ojs.t list 25 | -> unit) 26 | -> unit 27 | -------------------------------------------------------------------------------- /src/extension_consts.ml: -------------------------------------------------------------------------------- 1 | let ocaml_prefixed key = "ocaml." ^ key 2 | 3 | module Commands = struct 4 | let select_sandbox = ocaml_prefixed "select-sandbox" 5 | let install_ocaml_lsp_server = ocaml_prefixed "install-ocaml-lsp-server" 6 | let upgrade_ocaml_lsp_server = ocaml_prefixed "update-ocaml-lsp-server" 7 | let restart_language_server = ocaml_prefixed "server.restart" 8 | let select_sandbox_and_open_terminal = ocaml_prefixed "open-terminal-select" 9 | let open_terminal = ocaml_prefixed "open-terminal" 10 | let switch_impl_intf = ocaml_prefixed "switch-impl-intf" 11 | let remove_switch = ocaml_prefixed "remove-switch" 12 | let refresh_switches = ocaml_prefixed "refresh-switches" 13 | let refresh_sandbox = ocaml_prefixed "refresh-sandbox" 14 | let upgrade_sandbox = ocaml_prefixed "upgrade-sandbox" 15 | let install_sandbox = ocaml_prefixed "install-sandbox" 16 | let uninstall_sandbox_package = ocaml_prefixed "uninstall-sandbox-package" 17 | let open_switches_documentation = ocaml_prefixed "open-switches-documentation" 18 | let open_sandbox_documentation = ocaml_prefixed "open-sandbox-documentation" 19 | let stop_documentation_server = ocaml_prefixed "stop-documentation-server" 20 | let generate_sandbox_documentation = ocaml_prefixed "generate-sandbox-documentation" 21 | let open_current_dune_file = ocaml_prefixed "current-dune-file" 22 | let evaluate_selection = ocaml_prefixed "evaluate-selection" 23 | let open_repl = ocaml_prefixed "open-repl" 24 | let next_hole = ocaml_prefixed "next-hole" 25 | let prev_hole = ocaml_prefixed "prev-hole" 26 | let open_ast_explorer_to_the_side = ocaml_prefixed "open-ast-explorer-to-the-side" 27 | let reveal_ast_node = ocaml_prefixed "reveal-ast-node" 28 | let switch_hover_mode = ocaml_prefixed "switch-hover-mode" 29 | let show_preprocessed_document = ocaml_prefixed "show-preprocessed-document" 30 | let open_pp_editor_and_ast_explorer = ocaml_prefixed "open-pp-editor-and-ast-explorer" 31 | let open_ocamllsp_output = ocaml_prefixed "open-ocamllsp-output" 32 | let open_ocaml_platform_ext_output = ocaml_prefixed "open-ocaml-platform-ext-output" 33 | let open_ocaml_commands_output = ocaml_prefixed "open-ocaml-commands-output" 34 | let start_debugging = ocaml_prefixed "start-debugging" 35 | let goto_closure_code_location = ocaml_prefixed "goto-closure-code-location" 36 | let ask_debug_program = ocaml_prefixed "ask-debug-program" 37 | let copy_type_under_cursor = ocaml_prefixed "copy-type-under-cursor" 38 | let construct = ocaml_prefixed "construct" 39 | let merlin_jump = ocaml_prefixed "jump" 40 | let search_by_type = ocaml_prefixed "search-by-type" 41 | let navigate_typed_holes = ocaml_prefixed "navigate-typed-holes" 42 | let type_selection = ocaml_prefixed "type-selection" 43 | let type_previous_selection = ocaml_prefixed "type-previous-selection" 44 | let augment_selection_type_verbosity = ocaml_prefixed "augment-selection-type-verbosity" 45 | end 46 | 47 | module Command_errors = struct 48 | let text_editor_must_be_active ~expl cmd_name = 49 | Printf.sprintf 50 | "The command \"OCaml: %s\" should be run only with a file open in the editor. %s" 51 | cmd_name 52 | expl 53 | ;; 54 | end 55 | 56 | module Debuggers = struct 57 | let earlybird = ocaml_prefixed "earlybird" 58 | end 59 | 60 | (* TODO: Refactor the code so that we don't need any "constants" module *) 61 | -------------------------------------------------------------------------------- /src/extension_instance.mli: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | type t 4 | 5 | val make : unit -> t 6 | val sandbox : t -> Sandbox.t 7 | val set_sandbox : t -> Sandbox.t -> unit 8 | val language_client : t -> LanguageClient.t option 9 | val ocaml_lsp : t -> Ocaml_lsp.t option 10 | val check_ocaml_lsp_available : Sandbox.t -> (unit, string) result Promise.t 11 | 12 | val start_documentation_server 13 | : t 14 | -> path:Path.t 15 | -> (Documentation_server.t, unit) result Promise.t 16 | 17 | val stop_documentation_server : t -> unit 18 | val lsp_client : t -> (LanguageClient.t * Ocaml_lsp.t) option 19 | val ocaml_version_exn : t -> Ocaml_version.t 20 | val start_language_server : t -> unit Promise.t 21 | val install_ocaml_lsp_server : Sandbox.t -> unit Promise.t 22 | val upgrade_ocaml_lsp_server : Sandbox.t -> unit Promise.t 23 | 24 | val set_configuration 25 | : t 26 | -> ?codelens:bool option 27 | -> ?extended_hover:bool option 28 | -> ?standard_hover:bool option 29 | -> ?dune_diagnostics:bool option 30 | -> ?syntax_documentation:bool option 31 | -> unit 32 | -> unit 33 | 34 | val open_terminal : Sandbox.t -> unit 35 | val disposable : t -> Disposable.t 36 | val repl : t -> Terminal_sandbox.t option 37 | val set_repl : t -> Terminal.t -> unit 38 | val close_repl : t -> unit 39 | val update_ocaml_info : t -> unit Promise.t 40 | val ast_editor_state : t -> Ast_editor_state.t 41 | -------------------------------------------------------------------------------- /src/ocaml_lsp.mli: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | type t 4 | 5 | val of_initialize_result : LanguageClient.InitializeResult.t -> t 6 | val is_version_up_to_date : t -> Ocaml_version.t -> (unit, [ `Msg of string ]) result 7 | val can_handle_switch_impl_intf : t -> bool 8 | val can_handle_infer_intf : t -> bool 9 | val can_handle_typed_holes : t -> bool 10 | val can_handle_type_selection : t -> bool 11 | val can_handle_construct : t -> bool 12 | val can_handle_merlin_jump : t -> bool 13 | val can_handle_search_by_type : t -> bool 14 | val suggest_to_upgrade_ocaml_lsp_server : ?message:string -> unit -> unit Promise.t 15 | 16 | module OcamllspSettingEnable : sig 17 | include Ojs.T 18 | 19 | val enable : t -> bool option 20 | val create : enable:bool -> t 21 | end 22 | 23 | module OcamllspSettings : sig 24 | include Ojs.T 25 | 26 | val codelens : t -> OcamllspSettingEnable.t option 27 | val extendedHover : t -> OcamllspSettingEnable.t option 28 | val standardHover : t -> OcamllspSettingEnable.t option 29 | val duneDiagnostics : t -> OcamllspSettingEnable.t option 30 | val syntaxDocumentation : t -> OcamllspSettingEnable.t option 31 | 32 | val create 33 | : codelens:OcamllspSettingEnable.t option 34 | -> extendedHover:OcamllspSettingEnable.t option 35 | -> standardHover:OcamllspSettingEnable.t option 36 | -> duneDiagnostics:OcamllspSettingEnable.t option 37 | -> syntaxDocumentation:OcamllspSettingEnable.t option 38 | -> t 39 | end 40 | -------------------------------------------------------------------------------- /src/ocaml_windows.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | let ocaml_env_command = { Cmd.bin = Path.of_string "ocaml-env"; args = [] } 4 | 5 | let ocaml_env_setting = 6 | Settings.create_setting 7 | ~scope:Global 8 | ~key:"ocaml.useOcamlEnv" 9 | ~of_json:Jsonoo.Decode.bool 10 | ~to_json:Jsonoo.Encode.bool 11 | ;; 12 | 13 | let use_ocaml_env () = 14 | match Platform.t, Settings.get ocaml_env_setting with 15 | | Win32, Some true -> 16 | let open Promise.Syntax in 17 | let+ checked = Cmd.check_spawn ocaml_env_command in 18 | Result.is_ok checked 19 | | _ -> Promise.return false 20 | ;; 21 | 22 | let spawn_ocaml_env args = { ocaml_env_command with args = "exec" :: "--" :: args } 23 | 24 | let cygwin_home () = 25 | let open Promise.Syntax in 26 | let spawn = spawn_ocaml_env [ "cygpath"; "--windows"; "~" ] in 27 | let+ output = Cmd.output (Cmd.Spawn spawn) in 28 | match output with 29 | | Error _ as e -> e 30 | | Ok output -> 31 | let lines = String.split_on_chars ~on:[ '\n' ] output in 32 | (match lines with 33 | | home :: _ -> Ok home 34 | | _ -> 35 | let msg = Printf.sprintf "Unexpected output for Cygin home directory: %s" output in 36 | Error msg) 37 | ;; 38 | -------------------------------------------------------------------------------- /src/ocaml_windows.mli: -------------------------------------------------------------------------------- 1 | (* Whether to use ocaml-env for opam on Windows *) 2 | val use_ocaml_env : unit -> bool Promise.t 3 | 4 | (* Spawn command from OCaml for Windows using ocaml-env *) 5 | val spawn_ocaml_env : string list -> Cmd.spawn 6 | 7 | (* Path to home directory from OCaml for Windows *) 8 | val cygwin_home : unit -> (string, string) result Promise.t 9 | -------------------------------------------------------------------------------- /src/odig.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | type t = { cache_dir : Path.t } 4 | 5 | let make_odig_cmd sandbox = Sandbox.get_command sandbox "odig" 6 | 7 | (** TODO: propose to install odig. See 8 | https://github.com/ocamllabs/vscode-ocaml-platform/pull/771#discussion_r765297112 *) 9 | let of_sandbox (sandbox : Sandbox.t) = 10 | let make_odig_cmd = make_odig_cmd sandbox in 11 | let odig_version = make_odig_cmd [ "--version" ] in 12 | let open Promise.Syntax in 13 | let* output = Cmd.output odig_version in 14 | match output with 15 | | Ok _ -> 16 | let+ cache_dir = Cmd.output (make_odig_cmd [ "cache"; "path" ]) in 17 | (match cache_dir with 18 | | Ok cache_dir -> 19 | let cache_dir = cache_dir |> String.strip |> Path.of_string in 20 | Ok { cache_dir } 21 | | Error _ -> Error "OCaml: Failed to retrieve odig cache_dir") 22 | | Error _ -> 23 | Promise.resolve 24 | (Error 25 | "OCaml: the \"odig\" binary must be available in the current sandbox to \ 26 | generate documentation.") 27 | ;; 28 | 29 | let cmd_output ~sandbox ~args = Cmd.output (make_odig_cmd sandbox args) 30 | let html_dir t = Path.(t.cache_dir / "/html/") 31 | 32 | let odoc_exec t ~sandbox ~package_name = 33 | let open Promise.Syntax in 34 | let* ouput = cmd_output ~sandbox ~args:[ "odoc"; package_name ] in 35 | let+ result = 36 | match ouput with 37 | | Error _ as e -> Promise.resolve e 38 | | Ok _ -> 39 | let html_dir = html_dir t in 40 | let package_html_dir = Path.(html_dir / package_name) |> Path.to_string in 41 | let open Promise.Syntax in 42 | let+ dir_exists = Fs.exists package_html_dir in 43 | if dir_exists 44 | then Ok () 45 | else 46 | Error 47 | (Printf.sprintf 48 | "Directory %s should have been created but it doesn\'t exist." 49 | package_html_dir) 50 | in 51 | Result.map_error result ~f:(fun error -> 52 | let () = 53 | log "Failed to generate documentation for package %s. Error: %s" package_name error 54 | in 55 | error) 56 | ;; 57 | -------------------------------------------------------------------------------- /src/odig.mli: -------------------------------------------------------------------------------- 1 | (** Provide an interface to Odig. *) 2 | 3 | type t 4 | 5 | val of_sandbox : Sandbox.t -> (t, string) result Promise.t 6 | 7 | (** Generates the odoc API documentation and manual of [package_name]. Interface 8 | to the [odig odoc package_name] command *) 9 | val odoc_exec 10 | : t 11 | -> sandbox:Sandbox.t 12 | -> package_name:string 13 | -> (unit, string) result Promise.t 14 | 15 | val html_dir : t -> Path.t 16 | -------------------------------------------------------------------------------- /src/opam.mli: -------------------------------------------------------------------------------- 1 | (** Provide an interface to Opam. 2 | 3 | The functions in this module either use the result of opam commands, or use 4 | the filesystem to get the state of opam configurations. *) 5 | 6 | (** An Opam switch *) 7 | module Switch : sig 8 | type t = 9 | | Local of Path.t 10 | | Named of string 11 | 12 | (** {4 Constructors} *) 13 | 14 | val of_string : string -> t option 15 | 16 | (** {4 Properties} *) 17 | 18 | val name : t -> string 19 | 20 | (** {4 Utilities} *) 21 | 22 | val equal : t -> t -> bool 23 | end 24 | 25 | (** A package installed in an Opam switch *) 26 | module Package : sig 27 | type t 28 | 29 | (** {4 Properties} *) 30 | 31 | val name : t -> string 32 | val version : t -> string 33 | val documentation : t -> string option 34 | val synopsis : t -> string option 35 | val has_dependencies : t -> bool 36 | val dependencies : t -> (t list, string) result Promise.t 37 | end 38 | 39 | type t 40 | 41 | val make : ?root:Path.t -> unit -> t option Promise.t 42 | 43 | (** Install new packages in a switch *) 44 | val install : t -> Switch.t -> packages:string list -> Cmd.t 45 | 46 | (** Update the opam repository *) 47 | val update : t -> Switch.t -> Cmd.t 48 | 49 | (** Upgrade packages in a switch *) 50 | val upgrade : ?packages:string list -> t -> Switch.t -> Cmd.t 51 | 52 | (* Remove a list of packages from a switch *) 53 | val remove : t -> Switch.t -> string list -> Cmd.t 54 | 55 | (* Initialize a new Opam environment. *) 56 | val init : t -> Cmd.t 57 | 58 | (** {4 Working with switches} *) 59 | 60 | (** Create a new switch. *) 61 | val switch_create : t -> name:string -> args:string list -> Cmd.t 62 | 63 | (** List the opam switches available on the system. *) 64 | val switch_list : t -> Switch.t list Promise.t 65 | 66 | (** Checks that the given switch exists. *) 67 | val switch_exists : t -> Switch.t -> bool Promise.t 68 | 69 | (** Return the current opam switch. *) 70 | val switch_show : ?cwd:Path.t -> t -> Switch.t option Promise.t 71 | 72 | (** Return the compiler version used by the given switch. *) 73 | val switch_compiler : t -> Switch.t -> string option Promise.t 74 | 75 | (** Remove the given switch by calling [opam switch remove]. *) 76 | val switch_remove : t -> Switch.t -> Cmd.t 77 | 78 | (** {4 Working with packages} *) 79 | 80 | (** Return the list of installed packages in the given opam switch. *) 81 | val packages : t -> Switch.t -> (Package.t list, string) result Promise.t 82 | 83 | (** Return the list of root packages in the given opam switch. 84 | 85 | Root packages are packages that have been installed by the user, as opposed 86 | to packages that have been installed as a dependency of another package. *) 87 | val root_packages : t -> Switch.t -> (Package.t list, string) result Promise.t 88 | 89 | (** Uninstall a package from a switch by calling [opam uninstall]. *) 90 | val package_remove : t -> Switch.t -> Package.t list -> Cmd.t 91 | 92 | (** {4 General utilities} *) 93 | 94 | (** Execute an opam sub-command with in the given switch. *) 95 | val exec : t -> Switch.t -> args:string list -> Cmd.t 96 | 97 | (** Check that two instances of [Opam] are equal. *) 98 | val equal : t -> t -> bool 99 | -------------------------------------------------------------------------------- /src/output.ml: -------------------------------------------------------------------------------- 1 | let language_server_output_channel = 2 | lazy (Vscode.Window.createOutputChannel ~name:"OCaml Language Server" ()) 3 | ;; 4 | 5 | let extension_output_channel = 6 | lazy (Vscode.Window.createOutputChannel ~name:"OCaml Platform Extension" ()) 7 | ;; 8 | 9 | let command_output_channel = 10 | lazy (Vscode.Window.createOutputChannel ~name:"OCaml Commands" ()) 11 | ;; 12 | -------------------------------------------------------------------------------- /src/output.mli: -------------------------------------------------------------------------------- 1 | (** [language_server_output_channel] is the output channel that should be used 2 | by all ocamllsp LanguageClients *) 3 | val language_server_output_channel : Vscode.OutputChannel.t Lazy.t 4 | 5 | (** [extension_output_channel] is the output channel that should be used for 6 | logs by the extension *) 7 | val extension_output_channel : Vscode.OutputChannel.t Lazy.t 8 | 9 | (** [command_output_channel] is the output channel for user-friendly logs of 10 | shell commands *) 11 | val command_output_channel : Vscode.OutputChannel.t Lazy.t 12 | -------------------------------------------------------------------------------- /src/path.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | type t = string 4 | 5 | let equal = String.equal 6 | let iequal p0 p1 = String.equal (String.lowercase p0) (String.lowercase p1) 7 | let of_string s = s 8 | let to_string s = s 9 | let delimiter = Node.Path.delimiter 10 | let sep = Node.Path.sep 11 | let is_absolute t = Node.Path.isAbsolute t 12 | let compare = String.compare 13 | let dirname = Node.Path.dirname 14 | let extname = Node.Path.extname 15 | let basename = Node.Path.basename 16 | let join x y = Node.Path.join [ x; y ] 17 | let ( / ) = join 18 | let relative = join 19 | let relative_all p xs = List.fold_left xs ~f:join ~init:p 20 | let with_ext x ~ext = x ^ ext 21 | 22 | let is_root = function 23 | | "" -> true 24 | | x -> equal (dirname x) x 25 | ;; 26 | 27 | let parent x = if is_root x then None else Some (dirname x) 28 | let asset name = of_string (Node.__filename () ^ "/../../assets/" ^ name) 29 | -------------------------------------------------------------------------------- /src/path.mli: -------------------------------------------------------------------------------- 1 | (** Representation of path *) 2 | 3 | type t 4 | 5 | val equal : t -> t -> bool 6 | 7 | (** [iequal p0 p1] is [true] if and only if [p1] and [p2] are equal but case 8 | insensitive to any ASCII-uppercase/-lowercase differences. *) 9 | val iequal : t -> t -> bool 10 | 11 | val of_string : string -> t 12 | val to_string : t -> string 13 | val delimiter : char 14 | val sep : char 15 | val is_absolute : t -> bool 16 | val compare : t -> t -> int 17 | val dirname : t -> string 18 | val extname : t -> string 19 | val basename : t -> string 20 | val join : t -> t -> t 21 | val ( / ) : t -> string -> t 22 | val relative : t -> string -> t 23 | val relative_all : t -> string list -> t 24 | val with_ext : t -> ext:string -> t 25 | val parent : t -> t option 26 | val is_root : t -> bool 27 | val asset : string -> t 28 | -------------------------------------------------------------------------------- /src/platform.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | type t = 4 | | Win32 5 | | Darwin 6 | | Linux 7 | | Other 8 | 9 | let of_string = function 10 | | "win32" -> Win32 11 | | "darwin" -> Darwin 12 | | "linux" -> Linux 13 | | _ -> Other 14 | ;; 15 | 16 | let t = of_string Process.platform 17 | 18 | module Map = struct 19 | type 'a t = 20 | { win32 : 'a 21 | ; darwin : 'a 22 | ; linux : 'a 23 | ; other : 'a 24 | } 25 | 26 | let find { win32; darwin; linux; other } = function 27 | | Win32 -> win32 28 | | Darwin -> darwin 29 | | Linux -> linux 30 | | Other -> other 31 | ;; 32 | end 33 | 34 | type arch = 35 | | Arm 36 | | Arm64 37 | | Ia32 38 | | Mips 39 | | Mipsel 40 | | Ppc 41 | | Ppc64 42 | | S390 43 | | S390x 44 | | X32 45 | | X64 46 | 47 | let arch_of_string = function 48 | | "arm" -> Arm 49 | | "arm64" -> Arm64 50 | | "ia32" -> Ia32 51 | | "mips" -> Mips 52 | | "mipsel" -> Mipsel 53 | | "ppc" -> Ppc 54 | | "ppc64" -> Ppc64 55 | | "s390" -> S390 56 | | "s390x" -> S390x 57 | | "x32" -> X32 58 | | "x64" -> X64 59 | | _ -> assert false 60 | ;; 61 | 62 | let arch = Node.Process.arch |> arch_of_string 63 | 64 | type shell = 65 | | Sh of Path.t 66 | | PowerShell of Path.t 67 | 68 | let shell = 69 | let sh = Sh (Path.of_string "/bin/sh") in 70 | let powershell = 71 | PowerShell 72 | (Path.of_string "C:\\Windows\\System32\\WindowsPowerShell\\v1.0\\powershell.exe") 73 | in 74 | Map.find { win32 = powershell; darwin = sh; linux = sh; other = sh } t 75 | ;; 76 | -------------------------------------------------------------------------------- /src/platform.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | Win32 3 | | Darwin 4 | | Linux 5 | | Other 6 | 7 | val t : t 8 | 9 | module Map : sig 10 | type platform 11 | 12 | type 'a t = 13 | { win32 : 'a 14 | ; darwin : 'a 15 | ; linux : 'a 16 | ; other : 'a 17 | } 18 | 19 | val find : 'a t -> platform -> 'a 20 | end 21 | with type platform := t 22 | 23 | type arch = 24 | | Arm 25 | | Arm64 26 | | Ia32 27 | | Mips 28 | | Mipsel 29 | | Ppc 30 | | Ppc64 31 | | S390 32 | | S390x 33 | | X32 34 | | X64 35 | 36 | val arch : arch 37 | 38 | type shell = 39 | | Sh of Path.t 40 | | PowerShell of Path.t 41 | 42 | val shell : shell 43 | -------------------------------------------------------------------------------- /src/ppx_tools/dumpast.mli: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | (** [transform s k] transforms syntactically correct code containted in [s] into 4 | its AST serialized as a [Jsonoo.t] value. The kind [k] specifies if it is an 5 | interface or an implementation. [Error err_msg] is returned on syntax error *) 6 | val transform : string -> [ `Intf | `Impl ] -> (Jsonoo.t, string) result 7 | 8 | (** [from_structure str] serializes [str] as a [Jsonoo.t] value *) 9 | val from_structure : Parsetree.structure -> (Jsonoo.t, string) result 10 | 11 | (** [reparse str str'] creates a serialized AST as a [Jsonoo.t] value that has 12 | {i double locations} that come both from [str] and [str'] . This is possible 13 | under the assumption that [str] [str'] are structurally identical modulo 14 | [Location.t] values; If it's not the case, the result will only contain 15 | simple locations coming from [str] starting from the subtree that is 16 | structurally different. The result should a priori always be an [Ok json], 17 | since all possibles cases of [Error e] are accounted for. *) 18 | val reparse 19 | : Parsetree.structure_item list 20 | -> Parsetree.structure_item list 21 | -> (Jsonoo.t, string) result 22 | 23 | (** [reparse_signature sg sg'] does the same tranformation as {!reparse} but the 24 | starting point is [Parsetree.signature] *) 25 | val reparse_signature 26 | : Parsetree.signature_item list 27 | -> Parsetree.signature_item list 28 | -> (Jsonoo.t, string) result 29 | -------------------------------------------------------------------------------- /src/ppx_tools/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_tools) 3 | (libraries base vscode jsonoo promise_jsoo ppxlib) 4 | (modes byte)) 5 | -------------------------------------------------------------------------------- /src/ppx_tools/ppx_tools.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | module Dumpast = Dumpast 3 | 4 | let get_preprocessed_ast path = 5 | match Ppxlib.Ast_io.read_binary path with 6 | | exception Sys_error s -> Error s 7 | | Ok s -> Ok s 8 | | Error e -> Error e 9 | ;; 10 | 11 | let get_reparsed_code_from_pp_file ~path = 12 | get_preprocessed_ast path 13 | |> Result.map ~f:(fun source -> 14 | match Ppxlib.Ast_io.get_ast source with 15 | | Impl structure -> 16 | let structure = Ppxlib_ast.Selected_ast.To_ocaml.copy_structure structure in 17 | Stdlib.Format.asprintf "%a" Pprintast.structure structure 18 | | Intf signature -> 19 | let signature = Ppxlib_ast.Selected_ast.To_ocaml.copy_signature signature in 20 | Stdlib.Format.asprintf "%a" Pprintast.signature signature) 21 | ;; 22 | -------------------------------------------------------------------------------- /src/ppx_tools/ppx_tools.mli: -------------------------------------------------------------------------------- 1 | module Dumpast : module type of Dumpast 2 | 3 | val get_reparsed_code_from_pp_file : path:string -> (string, string) result 4 | val get_preprocessed_ast : string -> (Ppxlib.Ast_io.t, string) result 5 | -------------------------------------------------------------------------------- /src/repl.mli: -------------------------------------------------------------------------------- 1 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 2 | -------------------------------------------------------------------------------- /src/sandbox.mli: -------------------------------------------------------------------------------- 1 | (** Sandbox.ml exposes functions that let us 1. Run initial checks in the 2 | environment looking for a reliable sandbox ([Sandbox.init]) 3 | 4 | 2. Run a setup that would setup the sandbox provided that basic requirements 5 | are met ([Sandbox.run_setup]) 6 | 7 | 3. Helper functions that extract the tools from the setup sandbox. This 8 | includes just [ocamllsp] right now, but in future could include others like 9 | debuggers, REPLs etc that could be shipped with [vscode-ocaml-platform] 10 | plugin itself 11 | 12 | The separation between [init], [run_setup] and extraction helpers exist so 13 | that we can handle missing tools gracefully (ie provide degraded 14 | performance, direct user to install missing tools etc). Having a single 15 | [Sandbox.make()], for instance, would not make it this flexible. *) 16 | 17 | module Package : sig 18 | type t 19 | 20 | val name : t -> string 21 | val version : t -> string 22 | val synopsis : t -> string option 23 | val documentation : t -> string option 24 | val has_dependencies : t -> bool 25 | val dependencies : t -> (t list, string) result Promise.t 26 | end 27 | 28 | type t = 29 | | Opam of Opam.t * Opam.Switch.t 30 | | Esy of Esy.t * Esy.Manifest.t 31 | | Global 32 | | Custom of string 33 | 34 | val equal : t -> t -> bool 35 | val to_string : t -> string 36 | val to_pretty_string : t -> string 37 | val of_settings : unit -> t option Promise.t 38 | val detect : unit -> t option Promise.t 39 | val of_settings_or_detect : unit -> t option Promise.t 40 | val save_to_settings : t -> unit Promise.t 41 | 42 | (** [select_sandbox_and_save] requires the process environment the plugin is 43 | being run in (ie VSCode's process environment) and the project root and 44 | produces a promise of resources available that can later be passed on to 45 | [run_setup] that can be called to install the sandbox. *) 46 | val select_sandbox_and_save : unit -> t option Promise.t 47 | 48 | (** [select_sandbox] is the same as [select_sandbox_and_save] but does not save 49 | the sandbox configuration *) 50 | val select_sandbox : unit -> t option Promise.t 51 | 52 | (* Helper utils *) 53 | 54 | (** Extract command to run with the sandbox *) 55 | val get_command : t -> string -> string list -> Cmd.t 56 | 57 | (** Command to install dependencies in the sandbox *) 58 | val get_install_command : t -> string list -> Cmd.t option 59 | 60 | (** Command to exec a process in the sandbox *) 61 | val get_exec_command : t -> string list -> Cmd.t option 62 | 63 | (** The packages installed in the sandbox *) 64 | val packages : t -> (Package.t list, string) result Promise.t 65 | 66 | (** The packages that have been installed manually by the user in the sandbox *) 67 | val root_packages : t -> (Package.t list, string) result Promise.t 68 | 69 | (** Uninstall existing packages from the sandbox *) 70 | val uninstall_packages : t -> Package.t list -> unit Promise.t 71 | 72 | (** Install new packages in the sandbox *) 73 | val install_packages : t -> string list -> unit Promise.t 74 | 75 | (** Upgrade packages in the sandbox *) 76 | val upgrade_packages : ?packages:string list -> t -> unit Promise.t 77 | 78 | (** [ocaml_version] returns the version of the ocaml compiler installed in given 79 | sandbox. *) 80 | val ocaml_version : t -> (string, string) result Promise.t 81 | 82 | (** Focus on the command output channel. If [sandbox] is provided, the output 83 | channel will only be focused if the given sandbox supports package commands. *) 84 | val focus_on_package_command : ?sandbox:t -> unit -> unit 85 | -------------------------------------------------------------------------------- /src/settings.mli: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | (** This module is more of a "settings manager", which works with VS Code's 4 | [WorkspaceConfiguration] to retrieve and set settings. A setting is 5 | represented by ['value setting] type defined below. *) 6 | 7 | (** ['value setting] represents a setting (word used as a singular of 8 | "settings"), which has a value of type ['value] *) 9 | type 'value setting 10 | 11 | (* TODO: improve the treatment of "section" 12 | 13 | All settings in the extension are defined using a dot-separated path, e.g., 14 | [ocaml.dune.autoDetect]. In some places, we treat [key] as this whole path 15 | for the setting, [ocaml.dune.autoDetect], and in some places we use 16 | [autoDetect] as the key and [ocaml.dune] as the "section". VS Code allows 17 | this, but this non uniform treatment is bad. We should enforce a nicer 18 | API. *) 19 | 20 | val get : ?section:string -> 'value setting -> 'value option 21 | val set : ?section:string -> 'value setting -> 'value -> unit Promise.t 22 | 23 | val create_setting 24 | : scope:ConfigurationTarget.t 25 | -> key:string 26 | -> of_json:(Jsonoo.t -> 'value) 27 | -> to_json:('value -> Jsonoo.t) 28 | -> 'value setting 29 | 30 | (** replace workspaceFolder:folder_name variables with workspace folder paths *) 31 | val resolve_workspace_vars : string -> string 32 | 33 | (** replace workspace folder paths with workspaceFolder:folder_name variables *) 34 | val substitute_workspace_vars : string -> string 35 | 36 | val server_extraEnv : unit -> string Interop.Dict.t option 37 | val server_args_setting : string list setting 38 | val server_codelens_setting : bool setting 39 | val server_extendedHover_setting : bool setting 40 | val server_duneDiagnostics_setting : bool setting 41 | val server_syntaxDocumentation_setting : bool setting 42 | val server_typedHolesConstructAfterNavigate_setting : bool setting 43 | val server_constructRecursiveCalls_setting : bool setting 44 | -------------------------------------------------------------------------------- /src/switch_impl_intf.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | let insert_inferred_intf ~source_uri client text_editor = 4 | let open Promise.Syntax in 5 | match 6 | String.is_suffix source_uri ~suffix:".ml" || String.is_suffix source_uri ~suffix:".re" 7 | with 8 | | false -> Promise.return () 9 | | true -> 10 | (* If the source file was a .ml or .re, infer the interface *) 11 | let* inferred_intf = 12 | Custom_requests.send_request client Custom_requests.inferIntf source_uri 13 | in 14 | let+ edit_applied = 15 | TextEditor.edit 16 | text_editor 17 | ~callback:(fun ~editBuilder -> 18 | TextEditorEdit.insert 19 | editBuilder 20 | ~location:(Position.make ~line:1 ~character:1) 21 | ~value:inferred_intf) 22 | () 23 | in 24 | if not edit_applied then show_message `Error "Unable to insert inferred interface" 25 | ;; 26 | 27 | let request_switch client document = 28 | let open Promise.Syntax in 29 | let source_uri = Uri.toString (TextDocument.uri document) () in 30 | let fill_intf_if_empty_untitled text_editor = 31 | let doc = TextEditor.document text_editor in 32 | let is_empty_doc doc = TextDocument.getText doc () |> String.is_empty in 33 | if TextDocument.isUntitled doc && is_empty_doc doc 34 | then insert_inferred_intf ~source_uri client text_editor 35 | else Promise.return () 36 | in 37 | let* arr = 38 | Custom_requests.send_request client Custom_requests.switchImplIntf source_uri 39 | in 40 | match Array.to_list arr with 41 | | [] -> 42 | (* 'ocamllsp/switchImplIntf' command's response array cannot be empty *) 43 | assert false 44 | | [ file_uri ] -> 45 | let* text_editor = open_file_in_text_editor file_uri in 46 | fill_intf_if_empty_untitled text_editor 47 | | first_candidate :: other_candidates as candidates -> 48 | let first_candidate_item = 49 | QuickPickItem.create 50 | ~label:(Stdlib.Filename.basename first_candidate) 51 | ~picked:true 52 | () 53 | in 54 | let rest_candidate_items = 55 | List.map 56 | ~f:(fun c -> QuickPickItem.create ~label:(Stdlib.Filename.basename c) ()) 57 | other_candidates 58 | in 59 | let candidate_items_with_names = 60 | List.zip_exn (first_candidate_item :: rest_candidate_items) candidates 61 | in 62 | let file_options = 63 | QuickPickOptions.create ~canPickMany:false ~placeHolder:"Open a file..." () 64 | in 65 | let open Promise.Syntax in 66 | let* choice = 67 | Window.showQuickPickItems 68 | ~choices:candidate_items_with_names 69 | ~options:file_options 70 | () 71 | in 72 | (match choice with 73 | | None -> Promise.return () 74 | | Some file_uri -> 75 | let* text_editor = open_file_in_text_editor file_uri in 76 | fill_intf_if_empty_untitled text_editor) 77 | ;; 78 | -------------------------------------------------------------------------------- /src/switch_impl_intf.mli: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | val request_switch : LanguageClient.t -> Vscode.TextDocument.t -> unit Promise.t 4 | -------------------------------------------------------------------------------- /src/terminal_sandbox.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | module ShellPath = struct 4 | type t = string option 5 | 6 | let of_json json = 7 | let open Jsonoo.Decode in 8 | nullable string json 9 | ;; 10 | 11 | let to_json (t : t) = 12 | let open Jsonoo.Encode in 13 | nullable string t 14 | ;; 15 | 16 | let key = 17 | let linux = "shell.linux" in 18 | let map = 19 | { Platform.Map.win32 = "shell.windows"; darwin = "shell.osx"; linux; other = linux } 20 | in 21 | Platform.Map.find map Platform.t 22 | ;; 23 | 24 | let t = Settings.create_setting ~scope:Global ~key ~of_json ~to_json 25 | end 26 | 27 | module ShellArgs = struct 28 | type t = string list option 29 | 30 | let of_json json = 31 | let open Jsonoo.Decode in 32 | nullable (list string) json 33 | ;; 34 | 35 | let to_json (t : t) = 36 | let open Jsonoo.Encode in 37 | nullable (list string) t 38 | ;; 39 | 40 | let key = 41 | let linux = "shellArgs.linux" in 42 | let map = 43 | { Platform.Map.win32 = "shellArgs.windows" 44 | ; darwin = "shellArgs.osx" 45 | ; linux 46 | ; other = linux 47 | } 48 | in 49 | Platform.Map.find map Platform.t 50 | ;; 51 | 52 | let t = Settings.create_setting ~scope:Global ~key ~of_json ~to_json 53 | end 54 | 55 | let get_shell_path () = 56 | let shell_path = Option.join (Settings.get ~section:"ocaml.terminal" ShellPath.t) in 57 | match shell_path with 58 | | Some path -> path 59 | | None -> Env.shell () 60 | ;; 61 | 62 | let get_shell_args () = 63 | let get_args section = Option.join (Settings.get ~section ShellArgs.t) in 64 | match get_args "ocaml.terminal" with 65 | | Some args -> args 66 | | None -> 67 | (match get_args "terminal.integrated" with 68 | | Some args -> args 69 | | None -> []) 70 | ;; 71 | 72 | type t = Terminal.t 73 | 74 | let create ?name ?command sandbox = 75 | let ({ Cmd.bin; args } as command) = 76 | match command with 77 | | Some command -> command 78 | | None -> 79 | let shell_path = get_shell_path () in 80 | let shell_args = get_shell_args () in 81 | let command = Sandbox.get_command sandbox shell_path shell_args in 82 | Cmd.to_spawn command 83 | in 84 | Cmd.log (Spawn command); 85 | let name = Option.value name ~default:(Sandbox.to_pretty_string sandbox) in 86 | let shellPath = Path.to_string bin in 87 | let shellArgs = `Strings args in 88 | Window.createTerminal ~name ~shellPath ~shellArgs () 89 | ;; 90 | 91 | let dispose = Terminal.dispose 92 | let show ~preserveFocus t = Terminal.show ~preserveFocus t () 93 | 94 | let send t text = 95 | let addNewLine = not (String.is_suffix text ~suffix:"\n") in 96 | Terminal.sendText t ~text ~addNewLine () 97 | ;; 98 | -------------------------------------------------------------------------------- /src/terminal_sandbox.mli: -------------------------------------------------------------------------------- 1 | type t = Vscode.Terminal.t 2 | 3 | val create : ?name:string -> ?command:Cmd.spawn -> Sandbox.t -> t 4 | val dispose : t -> unit 5 | val show : preserveFocus:bool -> t -> unit 6 | val send : t -> string -> unit 7 | -------------------------------------------------------------------------------- /src/treeview_commands.ml: -------------------------------------------------------------------------------- 1 | let select_sandbox_item = 2 | let icon = 3 | `LightDark 4 | Vscode.LightDarkIcon. 5 | { light = `String (Path.asset "collection-light.svg" |> Path.to_string) 6 | ; dark = `String (Path.asset "collection-dark.svg" |> Path.to_string) 7 | } 8 | in 9 | let label = `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Select a Sandbox" ()) in 10 | let item = Vscode.TreeItem.make_label ~label () in 11 | let command = 12 | Vscode.Command.create ~title:"Select a Sandbox" ~command:"ocaml.select-sandbox" () 13 | in 14 | Vscode.TreeItem.set_iconPath item icon; 15 | Vscode.TreeItem.set_command item command; 16 | item 17 | ;; 18 | 19 | let terminal_item = 20 | let icon = 21 | `LightDark 22 | Vscode.LightDarkIcon. 23 | { light = `String (Path.asset "terminal-light.svg" |> Path.to_string) 24 | ; dark = `String (Path.asset "terminal-dark.svg" |> Path.to_string) 25 | } 26 | in 27 | let label = 28 | `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Open a sandboxed terminal" ()) 29 | in 30 | let item = Vscode.TreeItem.make_label ~label () in 31 | let command = 32 | Vscode.Command.create 33 | ~title:"Open a sandboxed terminal" 34 | ~command:"ocaml.open-terminal" 35 | () 36 | in 37 | Vscode.TreeItem.set_iconPath item icon; 38 | Vscode.TreeItem.set_command item command; 39 | item 40 | ;; 41 | 42 | let construct_item = 43 | let icon = `ThemeIcon (Vscode.ThemeIcon.make ~id:"tools" ()) in 44 | let label = 45 | `TreeItemLabel 46 | (Vscode.TreeItemLabel.create 47 | ~label:"List values that can fill the selected typed-hole" 48 | ()) 49 | in 50 | let item = Vscode.TreeItem.make_label ~label () in 51 | let command = Vscode.Command.create ~title:"Construct" ~command:"ocaml.construct" () in 52 | Vscode.TreeItem.set_iconPath item icon; 53 | Vscode.TreeItem.set_command item command; 54 | item 55 | ;; 56 | 57 | let jump_item = 58 | let icon = `ThemeIcon (Vscode.ThemeIcon.make ~id:"fold-up" ()) in 59 | let label = 60 | `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Jump to a specific target" ()) 61 | in 62 | let item = Vscode.TreeItem.make_label ~label () in 63 | let command = Vscode.Command.create ~title:"MerlinJump" ~command:"ocaml.jump" () in 64 | Vscode.TreeItem.set_iconPath item icon; 65 | Vscode.TreeItem.set_command item command; 66 | item 67 | ;; 68 | 69 | let type_search_item = 70 | let icon = `ThemeIcon (Vscode.ThemeIcon.make ~id:"search-view-icon" ()) in 71 | let label = 72 | `TreeItemLabel 73 | (Vscode.TreeItemLabel.create ~label:"Search a value by type or polarity" ()) 74 | in 75 | let item = Vscode.TreeItem.make_label ~label () in 76 | let command = 77 | Vscode.Command.create 78 | ~title:"Search a value by type or polarity" 79 | ~command:"ocaml.search-by-type" 80 | () 81 | in 82 | Vscode.TreeItem.set_iconPath item icon; 83 | Vscode.TreeItem.set_command item command; 84 | item 85 | ;; 86 | 87 | let navigate_holes_item = 88 | let icon = `ThemeIcon (Vscode.ThemeIcon.make ~id:"breakpoints-activate" ()) in 89 | let label = 90 | `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Navigate between typed holes" ()) 91 | in 92 | let item = Vscode.TreeItem.make_label ~label () in 93 | let command = 94 | Vscode.Command.create 95 | ~title:"Navigate typed holes" 96 | ~command:"ocaml.navigate-typed-holes" 97 | () 98 | in 99 | Vscode.TreeItem.set_iconPath item icon; 100 | Vscode.TreeItem.set_command item command; 101 | item 102 | ;; 103 | 104 | let items = 105 | [ select_sandbox_item 106 | ; terminal_item 107 | ; construct_item 108 | ; jump_item 109 | ; type_search_item 110 | ; navigate_holes_item 111 | ] 112 | ;; 113 | 114 | let getTreeItem ~element = `Value element 115 | 116 | let getChildren ?element () = 117 | match element with 118 | | None -> `Value (Some items) 119 | | Some _ -> `Value (Some []) 120 | ;; 121 | 122 | let register extension = 123 | let module TreeDataProvider = Vscode.TreeDataProvider.Make (Vscode.TreeItem) in 124 | let treeDataProvider = TreeDataProvider.create ~getTreeItem ~getChildren () in 125 | let disposable = 126 | Vscode.Window.registerTreeDataProvider 127 | (module Vscode.TreeItem) 128 | ~viewId:"ocaml-commands" 129 | ~treeDataProvider 130 | in 131 | Vscode.ExtensionContext.subscribe extension ~disposable 132 | ;; 133 | -------------------------------------------------------------------------------- /src/treeview_commands.mli: -------------------------------------------------------------------------------- 1 | (** Register the ocaml-commands tree view. *) 2 | val register : Vscode.ExtensionContext.t -> unit 3 | -------------------------------------------------------------------------------- /src/treeview_help.ml: -------------------------------------------------------------------------------- 1 | let discord_item = 2 | let icon = 3 | `LightDark 4 | Vscode.LightDarkIcon. 5 | { light = `String (Path.asset "discord-light.svg" |> Path.to_string) 6 | ; dark = `String (Path.asset "discord-dark.svg" |> Path.to_string) 7 | } 8 | in 9 | let label = `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Chat on Discord" ()) in 10 | let item = Vscode.TreeItem.make_label ~label () in 11 | let command = 12 | Vscode.Command.create 13 | ~title:"Open" 14 | ~command:"vscode.open" 15 | ~arguments: 16 | [ Vscode.Uri.parse "https://discord.gg/cCYQbqN" () |> Vscode.Uri.t_to_js ] 17 | () 18 | in 19 | Vscode.TreeItem.set_iconPath item icon; 20 | Vscode.TreeItem.set_command item command; 21 | item 22 | ;; 23 | 24 | let discuss_item = 25 | let icon = 26 | `LightDark 27 | Vscode.LightDarkIcon. 28 | { light = `String (Path.asset "chat-light.svg" |> Path.to_string) 29 | ; dark = `String (Path.asset "chat-dark.svg" |> Path.to_string) 30 | } 31 | in 32 | let label = 33 | `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Ask a question on Discuss" ()) 34 | in 35 | let item = Vscode.TreeItem.make_label ~label () in 36 | let command = 37 | Vscode.Command.create 38 | ~title:"Open" 39 | ~command:"vscode.open" 40 | ~arguments: 41 | [ Vscode.Uri.parse "https://discuss.ocaml.org/" () |> Vscode.Uri.t_to_js ] 42 | () 43 | in 44 | Vscode.TreeItem.set_iconPath item icon; 45 | Vscode.TreeItem.set_command item command; 46 | item 47 | ;; 48 | 49 | let github_item = 50 | let icon = 51 | `LightDark 52 | Vscode.LightDarkIcon. 53 | { light = `String (Path.asset "github-light.svg" |> Path.to_string) 54 | ; dark = `String (Path.asset "github-dark.svg" |> Path.to_string) 55 | } 56 | in 57 | let label = 58 | `TreeItemLabel (Vscode.TreeItemLabel.create ~label:"Open an issue on Github" ()) 59 | in 60 | let item = Vscode.TreeItem.make_label ~label () in 61 | let command = 62 | Vscode.Command.create 63 | ~title:"Open" 64 | ~command:"vscode.open" 65 | ~arguments: 66 | [ Vscode.Uri.parse "https://github.com/ocamllabs/vscode-ocaml-platform" () 67 | |> Vscode.Uri.t_to_js 68 | ] 69 | () 70 | in 71 | Vscode.TreeItem.set_iconPath item icon; 72 | Vscode.TreeItem.set_command item command; 73 | item 74 | ;; 75 | 76 | let items = [ discord_item; discuss_item; github_item ] 77 | let getTreeItem ~element = `Value element 78 | 79 | let getChildren ?element () = 80 | match element with 81 | | None -> `Value (Some items) 82 | | Some _ -> `Value (Some []) 83 | ;; 84 | 85 | let register extension = 86 | let module TreeDataProvider = Vscode.TreeDataProvider.Make (Vscode.TreeItem) in 87 | let treeDataProvider = TreeDataProvider.create ~getTreeItem ~getChildren () in 88 | let disposable = 89 | Vscode.Window.registerTreeDataProvider 90 | (module Vscode.TreeItem) 91 | ~viewId:"ocaml-help" 92 | ~treeDataProvider 93 | in 94 | Vscode.ExtensionContext.subscribe extension ~disposable 95 | ;; 96 | -------------------------------------------------------------------------------- /src/treeview_help.mli: -------------------------------------------------------------------------------- 1 | (** Register the ocaml-help tree view. *) 2 | val register : Vscode.ExtensionContext.t -> unit 3 | -------------------------------------------------------------------------------- /src/treeview_sandbox.mli: -------------------------------------------------------------------------------- 1 | (** Register the ocaml-sandbox tree view *) 2 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 3 | -------------------------------------------------------------------------------- /src/treeview_switches.mli: -------------------------------------------------------------------------------- 1 | (** Register the ocaml-switches tree view *) 2 | val register : Vscode.ExtensionContext.t -> Extension_instance.t -> unit 3 | -------------------------------------------------------------------------------- /src/vscode_ocaml_platform.ml: -------------------------------------------------------------------------------- 1 | open Import 2 | 3 | let suggest_to_pick_sandbox () = 4 | let open Promise.Syntax in 5 | let select_pm_button_text = "Select package manager and sandbox" in 6 | let+ selection = 7 | Window.showInformationMessage 8 | ~message: 9 | "OCaml Platform is using the package manager and sandbox available in the \ 10 | environment. Pick a particular package manager and sandbox by clicking the \ 11 | button below" 12 | ~choices:[ select_pm_button_text, () ] 13 | () 14 | in 15 | Option.iter selection ~f:(fun () -> 16 | let (_ : Ojs.t option Promise.t) = 17 | Vscode.Commands.executeCommand 18 | ~command:Extension_consts.Commands.select_sandbox 19 | ~args:[] 20 | in 21 | ()) 22 | ;; 23 | 24 | let notify_configuration_changes instance = 25 | Workspace.onDidChangeConfiguration 26 | ~listener:(fun _event -> 27 | let codelens = Settings.(get server_codelens_setting) in 28 | let extended_hover = Settings.(get server_extendedHover_setting) in 29 | let dune_diagnostics = Settings.(get server_duneDiagnostics_setting) in 30 | let syntax_documentation = Settings.(get server_syntaxDocumentation_setting) in 31 | Extension_instance.set_configuration 32 | instance 33 | ~codelens 34 | ~extended_hover 35 | ~dune_diagnostics 36 | ~syntax_documentation 37 | ()) 38 | () 39 | ;; 40 | 41 | let activate (extension : ExtensionContext.t) = 42 | let open Promise.Syntax in 43 | let instance = Extension_instance.make () in 44 | ExtensionContext.subscribe 45 | extension 46 | ~disposable:(Extension_instance.disposable instance); 47 | ExtensionContext.subscribe extension ~disposable:(notify_configuration_changes instance); 48 | Dune_formatter.register extension instance; 49 | Dune_task_provider.register extension instance; 50 | Extension_commands.register_all_commands extension instance; 51 | Treeview_switches.register extension instance; 52 | Treeview_sandbox.register extension instance; 53 | Treeview_commands.register extension; 54 | Treeview_help.register extension; 55 | Ast_editor.register extension instance; 56 | Cm_editor.register extension instance; 57 | Repl.register extension instance; 58 | Earlybird.register extension instance; 59 | let sandbox_opt = Sandbox.of_settings_or_detect () in 60 | let (_ : unit Promise.t) = 61 | let* sandbox_opt = sandbox_opt in 62 | let is_fallback = Option.is_none sandbox_opt in 63 | if 64 | is_fallback 65 | (* if the sandbox we just set up is a fallback sandbox, we create a pop-up 66 | message to offer the user to pick a sandbox they want; note: if the 67 | user picks another sandbox in the pop-up, we redo part of work we have 68 | just done; this is the case because we can't wait or rely on user to 69 | pick a sandbox: they may ignore the pop-up leaving the extension 70 | hanging, so we use fallback; w/ a proper detection mechanism, we would 71 | redo work in rare cases *) 72 | then suggest_to_pick_sandbox () 73 | else Promise.return () 74 | in 75 | let (_ : unit Promise.t) = 76 | let* sandbox_opt = sandbox_opt in 77 | let sandbox = Option.value sandbox_opt ~default:Sandbox.Global in 78 | Extension_instance.set_sandbox instance sandbox; 79 | let* () = Extension_instance.update_ocaml_info instance in 80 | let+ () = Extension_instance.start_language_server instance in 81 | () 82 | in 83 | Promise.return () 84 | ;; 85 | 86 | (* see {{:https://code.visualstudio.com/api/references/vscode-api#Extension} 87 | activate() *) 88 | let () = 89 | let open Js_of_ocaml.Js in 90 | export "activate" (wrap_callback activate) 91 | ;; 92 | -------------------------------------------------------------------------------- /src/vscode_ocaml_platform.mli: -------------------------------------------------------------------------------- 1 | (** Entry point *) 2 | -------------------------------------------------------------------------------- /syntaxes/META.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.ocaml.META", 3 | "fileTypes": ["META"], 4 | "patterns": [{ "include": "#comments" }, { "include": "#entries" }], 5 | "repository": { 6 | "comments": { 7 | "comment": "line comment", 8 | "name": "comment.line.META", 9 | "begin": "#", 10 | "end": "$" 11 | }, 12 | "entries": { 13 | "patterns": [ 14 | { 15 | "comment": "assignment or addition", 16 | "match": "\\b([[:word:].]+)[[:space:]]*(\\+?=)[[:space:]]*(\".*\")", 17 | "captures": { 18 | "1": { "name": "entity.name.tag.META" }, 19 | "2": { "name": "keyword.operator.META" }, 20 | "3": { "name": "string.quoted.double.META" } 21 | } 22 | }, 23 | { 24 | "comment": "assignment or addition with formal predicates", 25 | "begin": "\\b([[:word:].]+)[[:space:]]*\\(", 26 | "beginCaptures": { 27 | "1": { "name": "entity.name.tag.META" } 28 | }, 29 | "end": "\\)[[:space:]]*(\\+?=)[[:space:]]*(\".*\")", 30 | "endCaptures": { 31 | "1": { "name": "keyword.operator.META" }, 32 | "2": { "name": "string.quoted.double.META" } 33 | }, 34 | "patterns": [ 35 | { "match": "-", "name": "keyword.operator.META" }, 36 | { 37 | "comment": "standard predicates", 38 | "match": "\\b(byte|native|toploop|mt|mt_posix|mt_vm|gprof|autolink)\\b", 39 | "name": "constant.language.META" 40 | } 41 | ] 42 | }, 43 | { 44 | "comment": "subpackage", 45 | "begin": "\\b(package)[[:space:]]*(\"[^.]*\")[[:space:]]*\\(", 46 | "beginCaptures": { 47 | "1": { "name": "keyword.other.META" }, 48 | "2": { "name": "string.quoted.double.META" } 49 | }, 50 | "end": "\\)", 51 | "patterns": [{ "include": "$self" }] 52 | } 53 | ] 54 | } 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /syntaxes/atd.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "ATD", 3 | "scopeName": "source.atd", 4 | "fileTypes": ["atd"], 5 | "patterns": [ 6 | { "include": "source.ocaml#comments" }, 7 | { "include": "source.ocaml#strings" }, 8 | { "include": "#annotations" }, 9 | { "include": "#definitions" }, 10 | { "include": "#keywords" }, 11 | { "include": "#types" }, 12 | { "include": "source.ocaml#operators" }, 13 | { "include": "source.ocaml#identifiers" } 14 | ], 15 | "repository": { 16 | "annotations": { 17 | "patterns": [ 18 | { 19 | "begin": "(<)[[:space:]]*([[:lower:]_][[:word:]']*)", 20 | "end": ">", 21 | "beginCaptures": { 22 | "1": { "name": "keyword.other.atd" }, 23 | "2": { "name": "keyword.other.atd" } 24 | }, 25 | "endCaptures": [{ "name": "keyword.other.atd" }], 26 | "patterns": [{ "include": "$self" }] 27 | } 28 | ] 29 | }, 30 | "definitions": { 31 | "match": "\\b(type)[[:space:]]+('[[:alpha:]][[:word:]']*[[:space:]]+|\\(.*\\)[[:space:]]*)?([[:lower:]_][[:word:]']*)", 32 | "captures": { 33 | "1": { "name": "keyword.other.atd" }, 34 | "2": { "patterns": [{ "include": "$self" }] }, 35 | "3": { "name": "entity.name.function.binding.atd" } 36 | } 37 | }, 38 | "keywords": { 39 | "name": "keyword.other.atd", 40 | "match": "\\b(type|of|inherit)\\b(?!')" 41 | }, 42 | "types": { 43 | "patterns": [ 44 | { 45 | "comment": "type parameter", 46 | "name": "storage.type.ocaml.atd", 47 | "match": "'[[:alpha:]][[:word:]']*\\b" 48 | }, 49 | { 50 | "comment": "builtin type", 51 | "name": "support.type.ocaml.atd", 52 | "match": "\\b(unit|bool|int|float|string|abstract)\\b" 53 | } 54 | ] 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /syntaxes/menhir-action.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.action.menhir", 3 | "injectionSelector": "L:source.embedded-action.menhir", 4 | "patterns": [ 5 | { 6 | "begin": "(\\$(?:startpos|endpos|startofs|endofs|loc))[[:space:]]*\\(", 7 | "beginCaptures": { 8 | "1": { "name": "keyword.other.menhir" } 9 | }, 10 | "end": "\\)", 11 | "patterns": [ 12 | { "include": "#anon-capture" }, 13 | { "include": "source.ocaml.menhir#token-name" }, 14 | { "include": "source.ocaml.menhir#production-name" } 15 | ] 16 | }, 17 | { 18 | "match": "\\$(?:startpos|endpos|symbolstartpos|startofs|endofs|symbolstartofs|loc|sloc)\\b", 19 | "name": "keyword.other.menhir" 20 | }, 21 | { "include": "#anon-capture" } 22 | ], 23 | "repository": { 24 | "anon-capture": { 25 | "match": "\\$[[:digit:]]+\\b", 26 | "name": "keyword.other.menhir" 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /syntaxes/merlin.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.ocaml.merlin", 3 | "fileTypes": ["merlin"], 4 | "patterns": [ 5 | { "include": "#comment" }, 6 | { "include": "#directory" }, 7 | { "include": "#flag" }, 8 | { "include": "#package" } 9 | ], 10 | "repository": { 11 | "comment": { 12 | "begin": "#", 13 | "end": "$", 14 | "name": "comment.line.merlin" 15 | }, 16 | "directory": { 17 | "begin": "\\b(B|S)\\b", 18 | "end": "$", 19 | "beginCaptures": { 20 | "1": { "name": "keyword.other.merlin" } 21 | }, 22 | "name": "string.other.merlin", 23 | "patterns": [ 24 | { 25 | "match": "[:./ \\\\]", 26 | "name": "keyword.other.path.merlin" 27 | }, 28 | { 29 | "match": "[*?]", 30 | "name": "keyword.other.glob.merlin" 31 | } 32 | ] 33 | }, 34 | "flag": { 35 | "begin": "\\b(FLG)\\b", 36 | "end": "$", 37 | "beginCaptures": { 38 | "1": { "name": "keyword.other.merlin" } 39 | }, 40 | "patterns": [ 41 | { 42 | "begin": "\"", 43 | "end": "\"", 44 | "name": "string.quoted.double.merlin" 45 | }, 46 | { 47 | "match": "([\\-\\+])\\b(?:([[:digit:]]+)|([[:lower:]][[:word:]]*))\\b", 48 | "captures": { 49 | "1": { "name": "keyword.other.merlin" }, 50 | "2": { "name": "constant.language.merlin" }, 51 | "3": { "name": "variable.parameter.merlin" } 52 | } 53 | } 54 | ] 55 | }, 56 | "package": { 57 | "begin": "\\b(PKG)\\b", 58 | "end": "$", 59 | "beginCaptures": { 60 | "1": { "name": "storage.type.merlin" } 61 | }, 62 | "patterns": [ 63 | { 64 | "match": "(?", 34 | "beginCaptures": [{ "name": "keyword.operator.ocamlbuild" }], 35 | "endCaptures": [{ "name": "keyword.operator.ocamlbuild" }], 36 | "name": "string.quoted.double.ocamlbuild", 37 | "patterns": [{ "include": "#patterns" }] 38 | }, 39 | { 40 | "comment": "quoted string", 41 | "name": "string.quoted.double.ocamlbuild", 42 | "begin": "\"", 43 | "end": "\"" 44 | }, 45 | { 46 | "comment": "boolean", 47 | "name": "constant.language.ocamlbuild", 48 | "match": "\\b(true|false)\\b" 49 | }, 50 | { 51 | "comment": "operators", 52 | "name": "keyword.operator.ocamlbuild", 53 | "match": "\\b(or|and|not)\\b" 54 | }, 55 | { "include": "#variables" }, 56 | { "include": "$self" } 57 | ] 58 | }, 59 | 60 | "patterns": { 61 | "comment": "glob patterns", 62 | "patterns": [ 63 | { "name": "keyword.operator.ocamlbuild", "match": "\\?" }, 64 | { "name": "constant.language.ocamlbuild", "match": "\\*" }, 65 | { 66 | "begin": "{", 67 | "end": "}", 68 | "beginCaptures": [{ "name": "keyword.operator.ocamlbuild" }], 69 | "endCaptures": [{ "name": "keyword.operator.ocamlbuild" }], 70 | "patterns": [ 71 | { "name": "keyword.operator.ocamlbuild", "match": "," }, 72 | { "include": "#patterns" } 73 | ] 74 | }, 75 | { 76 | "begin": "\\[\\^?", 77 | "end": "\\]", 78 | "beginCaptures": [{ "name": "keyword.operator.ocamlbuild" }], 79 | "endCaptures": [{ "name": "keyword.operator.ocamlbuild" }] 80 | } 81 | ] 82 | }, 83 | 84 | "variables": { 85 | "comment": "pattern variables", 86 | "patterns": [ 87 | { 88 | "match": "(%)\\([^:)]*\\)", 89 | "captures": { 90 | "1": { "name": "keyword.operator.ocamlbuild" } 91 | }, 92 | "patterns": [{ "include": "#expressions" }] 93 | }, 94 | { 95 | "begin": "(%)\\([^:]*(:)", 96 | "end": "\\)", 97 | "beginCaptures": { 98 | "1": { "name": "keyword.operator.ocamlbuild" }, 99 | "2": { "name": "keyword.operator.ocamlbuild" } 100 | }, 101 | "patterns": [{ "include": "#expressions" }] 102 | }, 103 | { 104 | "name": "keyword.operator.ocamlbuild", 105 | "match": "%" 106 | } 107 | ] 108 | } 109 | } 110 | } 111 | -------------------------------------------------------------------------------- /syntaxes/ocamllex.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "OCamllex", 3 | "scopeName": "source.ocaml.ocamllex", 4 | "fileTypes": ["mll"], 5 | "foldingStartMarker": "{", 6 | "foldingStopMarker": "}", 7 | "keyEquivalent": "^~O", 8 | "patterns": [ 9 | { 10 | "include": "source.ocaml#comments" 11 | }, 12 | { 13 | "include": "source.ocaml#strings" 14 | }, 15 | { 16 | "include": "source.ocaml#characters" 17 | }, 18 | 19 | { 20 | "include": "#rules" 21 | }, 22 | { 23 | "include": "#keywords" 24 | }, 25 | { 26 | "include": "#actions" 27 | }, 28 | { 29 | "include": "#regex" 30 | }, 31 | 32 | { 33 | "match": "(’|‘|“|”)", 34 | "name": "invalid.illegal.unrecognized-character.ocamllex" 35 | } 36 | ], 37 | "repository": { 38 | "rules": { 39 | "match": "\\b(rule|and)[[:space:]]+([[:lower:]][[:word:]']*('|\\b))", 40 | "captures": { 41 | "1": { 42 | "name": "keyword.other.ocamllex" 43 | }, 44 | "2": { 45 | "name": "entity.name.function.rule.ocamllex" 46 | } 47 | } 48 | }, 49 | 50 | "keywords": { 51 | "patterns": [ 52 | { 53 | "comment": "ocamllex reserved keywords", 54 | "name": "keyword.other.ocamllex", 55 | "match": "\\b(let|as|rule|and|parse|shortest|refill)\\b(?!')" 56 | }, 57 | { 58 | "comment": "assignment operator", 59 | "match": "=", 60 | "name": "keyword.operator.symbol.ocamllex" 61 | } 62 | ] 63 | }, 64 | 65 | "actions": { 66 | "patterns": [ 67 | { 68 | "comment": "embedded ocaml source", 69 | "begin": "{", 70 | "beginCaptures": [{ "name": "keyword.other.ocamllex" }], 71 | "end": "}", 72 | "endCaptures": [{ "name": "keyword.other.ocamllex" }], 73 | "patterns": [{ "include": "source.ocaml" }] 74 | } 75 | ] 76 | }, 77 | 78 | "regex": { 79 | "patterns": [ 80 | { 81 | "comment": "regex character set", 82 | "name": "punctuation.character-set.ocamllex", 83 | "match": "\\[|\\]" 84 | }, 85 | { 86 | "comment": "regex group", 87 | "name": "punctuation.group.ocamllex", 88 | "match": "\\(|\\)" 89 | }, 90 | { 91 | "comment": "regex operators", 92 | "name": "keyword.operator.ocamllex", 93 | "match": "\\^|#|\\*|\\+|\\?|\\||-" 94 | }, 95 | { 96 | "comment": "end-of-file token", 97 | "name": "constant.language.eof.ocamllex", 98 | "match": "\\beof\\b" 99 | }, 100 | { 101 | "comment": "reference to regex pattern", 102 | "name": "entity.name.type.reference.ocamllex", 103 | "match": "\\b[[:alpha:]][[:word:]']*('|\\b)" 104 | } 105 | ] 106 | } 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /syntaxes/opam-install.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.ocaml.opam-install", 3 | "fileTypes": ["install"], 4 | "patterns": [ 5 | { 6 | "name": "comment.line.opam-install", 7 | "begin": "#", 8 | "end": "$" 9 | }, 10 | { 11 | "match": "^[[:space:]]*(lib|lib_root|libexec|libexec_root|bin|sbin|toplevel|share|share_root|etc|doc|stublibs|man|misc)[[:space:]]*(:)", 12 | "captures": { 13 | "1": { "name": "entity.name.tag.opam-install" }, 14 | "2": { "name": "keyword.operator.opam-install" } 15 | } 16 | }, 17 | { 18 | "name": "string.quoted.double.opam-install", 19 | "begin": "\"", 20 | "end": "\"" 21 | } 22 | ] 23 | } 24 | -------------------------------------------------------------------------------- /syntaxes/opam.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "source.ocaml.opam", 3 | "fileTypes": ["opam"], 4 | "patterns": [ 5 | { "include": "#comments" }, 6 | { "include": "#fields" }, 7 | { "include": "#values" } 8 | ], 9 | "repository": { 10 | "comments": { 11 | "patterns": [ 12 | { 13 | "comment": "block comment", 14 | "name": "comment.block.opam", 15 | "begin": "\\(\\*", 16 | "end": "\\*\\)" 17 | }, 18 | { 19 | "comment": "line comment", 20 | "name": "comment.line.opam", 21 | "begin": "#", 22 | "end": "$" 23 | } 24 | ] 25 | }, 26 | 27 | "fields": { 28 | "comment": "labeled field", 29 | "match": "^([[:word:]-]*[[:alpha:]][[:word:]-]*)(:)", 30 | "captures": { 31 | "1": { "name": "entity.name.tag.opam" }, 32 | "2": { "name": "keyword.operator.opam" } 33 | } 34 | }, 35 | 36 | "values": { 37 | "patterns": [ 38 | { 39 | "comment": "boolean literal", 40 | "name": "constant.language.opam", 41 | "match": "\\b(true|false)\\b" 42 | }, 43 | { 44 | "comment": "integer literal", 45 | "name": "constant.numeric.decimal.opam", 46 | "match": "(\\b|\\-?)[[:digit:]]+\\b" 47 | }, 48 | { 49 | "comment": "double-quote string literal", 50 | "name": "string.quoted.double.opam", 51 | "begin": "\"", 52 | "end": "\"", 53 | "patterns": [{ "include": "#string-elements" }] 54 | }, 55 | { 56 | "comment": "triple-double-quote string literal", 57 | "name": "string.quoted.triple-double.opam", 58 | "begin": "\"\"\"", 59 | "end": "\"\"\"", 60 | "patterns": [{ "include": "#string-elements" }] 61 | }, 62 | { 63 | "comment": "operator", 64 | "name": "keyword.operator.opam", 65 | "match": "[!=<>\\|&?:]+" 66 | }, 67 | { 68 | "comment": "identifier", 69 | "match": "\\b([[:word:]+-]+)\\b", 70 | "name": "variable.parameter.opam" 71 | } 72 | ] 73 | }, 74 | 75 | "string-elements": { 76 | "patterns": [ 77 | { 78 | "comment": "escaped backslash", 79 | "name": "constant.character.escape.opam", 80 | "match": "\\\\\\\\" 81 | }, 82 | { 83 | "comment": "escaped quote or whitespace", 84 | "name": "constant.character.escape.opam", 85 | "match": "\\\\[\"ntbr\\n]" 86 | }, 87 | { 88 | "comment": "character from decimal ASCII code", 89 | "name": "constant.character.escape.opam", 90 | "match": "\\\\[[:digit:]]{3}" 91 | }, 92 | { 93 | "comment": "character from hexadecimal ASCII code", 94 | "name": "constant.character.escape.opam", 95 | "match": "\\\\x[[:xdigit:]]{2}" 96 | }, 97 | { 98 | "comment": "variable interpolation", 99 | "name": "constant.variable.opam", 100 | "begin": "%\\{", 101 | "end": "}\\%" 102 | }, 103 | { 104 | "comment": "unknown escape sequence", 105 | "name": "invalid.illegal.unknown-escape.opam", 106 | "match": "\\\\." 107 | } 108 | ] 109 | } 110 | } 111 | } 112 | -------------------------------------------------------------------------------- /syntaxes/reason-markdown-codeblock.json: -------------------------------------------------------------------------------- 1 | { 2 | "fileTypes": [], 3 | "injectionSelector": "L:text.html.markdown", 4 | "patterns": [{ "include": "#reason-code-block" }], 5 | "repository": { 6 | "reason-code-block": { 7 | "begin": "(^|\\G)([[:space:]]*)(\\`{3,}|~{3,})[[:space:]]*(?i:(re|reason|reasonml)([[:space:]]+[^`~]*)?$)", 8 | "name": "markup.fenced_code.block.markdown", 9 | "end": "(^|\\G)(\\2|[[:space:]]{0,3})(\\3)[[:space:]]*$", 10 | "beginCaptures": { 11 | "3": { "name": "punctuation.definition.markdown" }, 12 | "4": { "name": "fenced_code.block.language.markdown" }, 13 | "5": { "name": "fenced_code.block.language.attributes.markdown" } 14 | }, 15 | "endCaptures": { 16 | "3": { "name": "punctuation.definition.markdown" } 17 | }, 18 | "patterns": [ 19 | { 20 | "begin": "(^|\\G)([[:space:]]*)(.*)", 21 | "while": "(^|\\G)(?![[:space:]]*([`~]{3,})[[:space:]]*$)", 22 | "contentName": "meta.embedded.block.reason", 23 | "patterns": [ 24 | { 25 | "include": "source.reason" 26 | } 27 | ] 28 | } 29 | ] 30 | } 31 | }, 32 | "scopeName": "markdown.reason.codeblock" 33 | } 34 | -------------------------------------------------------------------------------- /tests/fixtures/sample-opam/foo.ml: -------------------------------------------------------------------------------- 1 | let hello () = print_endline "hey there" 2 | -------------------------------------------------------------------------------- /tests/fixtures/sample-opam/main.ml: -------------------------------------------------------------------------------- 1 | let () = Foo.hello () 2 | 3 | let () = Printf.printf "hello" 4 | -------------------------------------------------------------------------------- /tests/fixtures/sample-opam/sample-opam.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "Synopsis" 3 | maintainer: "foobar" 4 | authors: "foobar" 5 | license: "ISC" 6 | homepage: "foo" 7 | bug-reports: "https//example.com" 8 | depends: ["ocaml"] 9 | -------------------------------------------------------------------------------- /tests/suite/basic/problems.test.js: -------------------------------------------------------------------------------- 1 | const assert = require("node:assert/strict"); 2 | 3 | const problemLocations = { 4 | 'File "file.ml", line 4, characters 6-7:': [ 5 | "file.ml", 6 | "4", 7 | undefined, 8 | "6", 9 | "7", 10 | ], 11 | 12 | 'File "helloworld.ml", lines 4-7, characters 6-3:': [ 13 | "helloworld.ml", 14 | "4", 15 | "7", 16 | "6", 17 | "3", 18 | ], 19 | 20 | 'File "src/intf_error.ml", line 1:': [ 21 | "src/intf_error.ml", 22 | "1", 23 | undefined, 24 | undefined, 25 | undefined, 26 | ], 27 | }; 28 | 29 | const problemMessages = { 30 | "Error: This expression has type int": [ 31 | "Error", 32 | undefined, 33 | "This expression has type int", 34 | ], 35 | 36 | "Warning: Cannot safely evaluate the definition of the following cycle": [ 37 | "Warning", 38 | undefined, 39 | "Cannot safely evaluate the definition of the following cycle", 40 | ], 41 | 42 | "Warning 26: unused variable y.": ["Warning", "26", "unused variable y."], 43 | 44 | "Error (warning 8): this pattern-matching is not exhaustive.": [ 45 | "Error", 46 | "8", 47 | "this pattern-matching is not exhaustive.", 48 | ], 49 | }; 50 | 51 | suite("basic", () => { 52 | test("problem matcher", () => { 53 | const locationRegex = 54 | /^\s*\bFile\b\s*"(.*)",\s*\blines?\b\s*(\d+)(?:-(\d+))?(?:,\s*\bcharacters\b\s*(\d+)-(\d+)\s*)?:\s*$/; 55 | 56 | const messageRegex = 57 | /^(?:\s*\bParse\b\s*)?\s*\b([Ee]rror|Warning)\b\s*(?:(?:\(\s*\bwarning\b\s*)?(\d+)\)?)?\s*:\s*(.*)$/; 58 | 59 | for (const [problem, expected] of Object.entries(problemLocations)) { 60 | const captures = problem.match(locationRegex); 61 | assert.notStrictEqual( 62 | captures, 63 | null, 64 | `Location regex should match: ${problem}`, 65 | ); 66 | assert.deepStrictEqual(captures?.slice(1), expected); 67 | } 68 | 69 | for (const [problem, expected] of Object.entries(problemMessages)) { 70 | const captures = problem.match(messageRegex); 71 | assert.notStrictEqual( 72 | captures, 73 | null, 74 | `Message regex should match: ${problem}`, 75 | ); 76 | assert.deepStrictEqual(captures?.slice(1), expected); 77 | } 78 | }); 79 | }); 80 | -------------------------------------------------------------------------------- /tests/suite/opam/languageId.test.js: -------------------------------------------------------------------------------- 1 | const assert = require("node:assert/strict"); 2 | const path = require("node:path"); 3 | const vscode = require("vscode"); 4 | 5 | const root = path.resolve(__dirname, "../../../"); 6 | const fixtureSrcDir = path.join(root, "tests", "fixtures"); 7 | const sampleOpamSrc = path.join(fixtureSrcDir, "sample-opam"); 8 | 9 | suite("opam", () => { 10 | test("languageId", async () => { 11 | const foo = await vscode.workspace.openTextDocument( 12 | vscode.Uri.file(path.join(sampleOpamSrc, "foo.ml")), 13 | ); 14 | const main = await vscode.workspace.openTextDocument( 15 | vscode.Uri.file(path.join(sampleOpamSrc, "main.ml")), 16 | ); 17 | 18 | assert.strictEqual( 19 | foo.languageId, 20 | "ocaml", 21 | "Must be identified as an OCaml document", 22 | ); 23 | assert.strictEqual( 24 | main.languageId, 25 | "ocaml", 26 | "Must be identified as an OCaml document", 27 | ); 28 | }); 29 | }); 30 | -------------------------------------------------------------------------------- /tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "extends": [ 3 | "@tsconfig/strictest/tsconfig.json", 4 | "@tsconfig/node24/tsconfig.json" 5 | ], 6 | "compilerOptions": { 7 | "noEmit": true 8 | }, 9 | "exclude": ["_build", "_opam", "astexplorer", "dist", "node_modules"] 10 | } 11 | -------------------------------------------------------------------------------- /vscode-interop.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: 4 | "Interop library compatible with the vscode and vscode-node bindings" 5 | maintainer: ["Rudi Grinberg