diff --git a/ocaml-lsp-server/src/code_actions.ml b/ocaml-lsp-server/src/code_actions.ml index 662599eea..c2f7b9060 100644 --- a/ocaml-lsp-server/src/code_actions.ml +++ b/ocaml-lsp-server/src/code_actions.ml @@ -125,7 +125,7 @@ let compute server (params : CodeActionParams.t) = (match Document.syntax doc with | Ocamllex | Menhir | Cram | Dune -> Fiber.return (Reply.now (actions (dune_actions @ open_related)), state) - | Ocaml | Reason -> + | Ocaml | Reason | Mlx -> let reply () = let+ code_action_results = compute_ocaml_code_actions params state doc in List.concat [ code_action_results; dune_actions; open_related; merlin_jumps ] diff --git a/ocaml-lsp-server/src/document.ml b/ocaml-lsp-server/src/document.ml index ec1ec2956..1efbf24dc 100644 --- a/ocaml-lsp-server/src/document.ml +++ b/ocaml-lsp-server/src/document.ml @@ -32,6 +32,7 @@ module Syntax = struct | Menhir | Cram | Dune + | Mlx let human_name = function | Ocaml -> "OCaml" @@ -40,6 +41,7 @@ module Syntax = struct | Menhir -> "Menhir/ocamlyacc" | Cram -> "Cram" | Dune -> "Dune" + | Mlx -> "OCaml.mlx" ;; let all = @@ -52,6 +54,7 @@ module Syntax = struct ; "dune", Dune ; "dune-project", Dune ; "dune-workspace", Dune + ; "ocaml.mlx", Mlx ] ;; @@ -61,6 +64,7 @@ module Syntax = struct | s -> (match Filename.extension s with | ".eliomi" | ".eliom" | ".mli" | ".ml" -> Ok Ocaml + | ".mlx" -> Ok Mlx | ".rei" | ".re" -> Ok Reason | ".mll" -> Ok Ocamllex | ".mly" -> Ok Menhir @@ -252,7 +256,7 @@ let make wheel config pipeline (doc : DidOpenTextDocumentParams.t) ~position_enc let tdoc = Text_document.make ~position_encoding doc in let syntax = Syntax.of_text_document tdoc in match syntax with - | Ocaml | Reason -> make_merlin wheel config pipeline tdoc syntax + | Ocaml | Reason | Mlx -> make_merlin wheel config pipeline tdoc syntax | Ocamllex | Menhir | Cram | Dune -> Fiber.return (Other { tdoc; syntax })) ;; @@ -421,8 +425,8 @@ let close t = let get_impl_intf_counterparts m uri = let fpath = Uri.to_path uri in let fname = Filename.basename fpath in - let ml, mli, eliom, eliomi, re, rei, mll, mly = - "ml", "mli", "eliom", "eliomi", "re", "rei", "mll", "mly" + let ml, mli, eliom, eliomi, re, rei, mll, mly, mlx = + "ml", "mli", "eliom", "eliomi", "re", "rei", "mll", "mly", "mlx" in let exts_to_switch_to = let kind = @@ -436,13 +440,18 @@ let get_impl_intf_counterparts m uri = in match Syntax.of_fname fname with | Dune | Cram -> [] + (* TODO: Unsure about this, keeping it empty for now *) + | Mlx -> + (match kind with + | Intf -> [ re; ml; mly; mll ] + | Impl -> [ rei; mli; mly; mll ]) | Ocaml -> (match kind with - | Intf -> [ ml; mly; mll; eliom; re ] + | Intf -> [ ml; mly; mll; eliom; re; mlx ] | Impl -> [ mli; mly; mll; eliomi; rei ]) | Reason -> (match kind with - | Intf -> [ re; ml ] + | Intf -> [ re; ml; mlx ] | Impl -> [ rei; mli ]) | Ocamllex -> [ mli; rei ] | Menhir -> [ mli; rei ] diff --git a/ocaml-lsp-server/src/document.mli b/ocaml-lsp-server/src/document.mli index 735bfd659..6585b6f0b 100644 --- a/ocaml-lsp-server/src/document.mli +++ b/ocaml-lsp-server/src/document.mli @@ -10,6 +10,7 @@ module Syntax : sig | Menhir | Cram | Dune + | Mlx val human_name : t -> string val markdown_name : t -> string diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index ec7f8e119..39e58db09 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -203,7 +203,7 @@ let set_diagnostics detached diagnostics doc = in Diagnostics.set diagnostics (`Merlin (uri, [ no_reason_merlin ])); async (fun () -> Diagnostics.send diagnostics (`One uri)) - | Reason | Ocaml -> + | Reason | Ocaml | Mlx -> async (fun () -> let* () = Diagnostics.merlin_diagnostics diagnostics merlin in Diagnostics.send diagnostics (`One uri))) diff --git a/ocaml-lsp-server/src/ocamlformat.ml b/ocaml-lsp-server/src/ocamlformat.ml index 28437f21f..4d84d3aa3 100644 --- a/ocaml-lsp-server/src/ocamlformat.ml +++ b/ocaml-lsp-server/src/ocamlformat.ml @@ -100,8 +100,10 @@ let message = function type formatter = | Reason of Document.Kind.t | Ocaml of Uri.t + | Mlx of Uri.t let args = function + | Mlx uri | Ocaml uri -> [ sprintf "--name=%s" (Uri.to_path uri); "-" ] | Reason kind -> [ "--parse"; "re"; "--print"; "re" ] @@ -114,6 +116,7 @@ let args = function let binary_name t = match t with | Ocaml _ -> "ocamlformat" + | Mlx _ -> "ocamlformat-mlx" | Reason _ -> "refmt" ;; @@ -128,6 +131,7 @@ let formatter doc = match Document.syntax doc with | (Dune | Cram | Ocamllex | Menhir) as s -> Error (Unsupported_syntax s) | Ocaml -> Ok (Ocaml (Document.uri doc)) + | Mlx -> Ok (Mlx (Document.uri doc)) | Reason -> Ok (Reason diff --git a/ocaml-lsp-server/src/ocamlformat.mli b/ocaml-lsp-server/src/ocamlformat.mli index 0d6edc6c1..186f692ba 100644 --- a/ocaml-lsp-server/src/ocamlformat.mli +++ b/ocaml-lsp-server/src/ocamlformat.mli @@ -1,6 +1,7 @@ (** Generic formatting facility for OCaml and Reason sources. - Relies on [ocamlformat] for OCaml and [refmt] for reason *) + Relies on [ocamlformat] for OCaml, [ocamlformat-mlx] for OCaml.mlx, and + [refmt] for Reason. *) open Import diff --git a/ocaml-lsp-server/src/workspace_symbol.ml b/ocaml-lsp-server/src/workspace_symbol.ml index 60bed61de..1a97c8b90 100644 --- a/ocaml-lsp-server/src/workspace_symbol.ml +++ b/ocaml-lsp-server/src/workspace_symbol.ml @@ -70,17 +70,18 @@ end = struct open Browse_raw open Browse_tree - let id_of_patt = function - | { pat_desc = Tpat_var (id, _, _); _ } -> Some id + let name_of_patt = function + | { pat_desc = Tpat_var (_, name, _); _ } -> Some name | _ -> None ;; - let mk ?(children = []) ~location ~deprecated outline_kind id = + let mk ?(children = []) ~location ~deprecated outline_kind (id : string Location.loc) = { Query_protocol.outline_kind ; outline_type = None ; location + ; selection = id.loc ; children - ; outline_name = Ident.name id + ; outline_name = id.txt ; deprecated } ;; @@ -96,30 +97,30 @@ end = struct match node.t_node with | Value_binding vb -> let deprecated = Type_utils.is_deprecated vb.vb_attributes in - (match id_of_patt vb.vb_pat with + (match name_of_patt vb.vb_pat with | None -> None - | Some ident -> Some (mk ~location ~deprecated `Value ident)) + | Some name -> Some (mk ~location ~deprecated `Value name)) | Value_description vd -> let deprecated = Type_utils.is_deprecated vd.val_attributes in - Some (mk ~location ~deprecated `Value vd.val_id) + Some (mk ~location ~deprecated `Value vd.val_name) | Module_declaration md -> let children = get_mod_children node in - (match md.md_id with - | None -> None - | Some id -> + (match md.md_name with + | { txt = None; _ } -> None + | { txt = Some txt; loc } -> let deprecated = Type_utils.is_deprecated md.md_attributes in - Some (mk ~children ~location ~deprecated `Module id)) + Some (mk ~children ~location ~deprecated `Module { txt; loc })) | Module_binding mb -> let children = get_mod_children node in - (match mb.mb_id with - | None -> None - | Some id -> + (match mb.mb_name with + | { txt = None; _ } -> None + | { txt = Some txt; loc } -> let deprecated = Type_utils.is_deprecated mb.mb_attributes in - Some (mk ~children ~location ~deprecated `Module id)) + Some (mk ~children ~location ~deprecated `Module { txt; loc })) | Module_type_declaration mtd -> let children = get_mod_children node in let deprecated = Type_utils.is_deprecated mtd.mtd_attributes in - Some (mk ~deprecated ~children ~location `Modtype mtd.mtd_id) + Some (mk ~deprecated ~children ~location `Modtype mtd.mtd_name) | Type_declaration td -> let children = List.concat_map (Lazy.force node.t_children) ~f:(fun child -> @@ -129,16 +130,16 @@ end = struct match x.t_node with | Constructor_declaration c -> let deprecated = Type_utils.is_deprecated c.cd_attributes in - mk `Constructor c.cd_id ~deprecated ~location:c.cd_loc + mk `Constructor c.cd_name ~deprecated ~location:c.cd_loc | Label_declaration ld -> let deprecated = Type_utils.is_deprecated ld.ld_attributes in - mk `Label ld.ld_id ~deprecated ~location:ld.ld_loc + mk `Label ld.ld_name ~deprecated ~location:ld.ld_loc | _ -> assert false (* ! *)) | _ -> []) in let deprecated = Type_utils.is_deprecated td.typ_attributes in - Some (mk ~children ~location ~deprecated `Type td.typ_id) + Some (mk ~children ~location ~deprecated `Type td.typ_name) | Type_extension te -> let name = Path.name te.tyext_path in let children = @@ -151,16 +152,17 @@ end = struct ; outline_kind = `Type ; outline_type = None ; location + ; selection = te.tyext_txt.loc ; children ; deprecated } | Extension_constructor ec -> let deprecated = Type_utils.is_deprecated ec.ext_attributes in - Some (mk ~location `Exn ec.ext_id ~deprecated) + Some (mk ~location `Exn ec.ext_name ~deprecated) | Class_declaration cd -> let children = List.concat_map (Lazy.force node.t_children) ~f:get_class_elements in let deprecated = Type_utils.is_deprecated cd.ci_attributes in - Some (mk ~children ~location `Class cd.ci_id_class_type ~deprecated) + Some (mk ~children ~location `Class cd.ci_id_name ~deprecated) | _ -> None and get_class_elements node = @@ -178,6 +180,7 @@ end = struct ; outline_kind ; outline_type = None ; location = str_loc.Location.loc + ; selection = str_loc.Location.loc ; children = [] ; deprecated } @@ -218,6 +221,7 @@ let outline_kind kind : SymbolKind.t = | `Type -> String | `Exn -> Constructor | `Class -> Class + | `ClassType -> Interface | `Method -> Method ;;