Merge pull request #313 from tmattio/organize-req-actions

Reorganize code actions and custom requests into subdirs

ocaml-lsp-server/src/inferred_intf.ml → ocaml-lsp-server/src/code_actions/action_inferred_intf.ml

@@ -59,11 +59,7 @@ let code_action doc (state : State.t) (params : CodeActionParams.t) =
   | Impl -> Fiber.return (Ok None)
   | Intf -> (
     let intf_uri = Document.uri doc in
-    let intf_path = Uri.to_path intf_uri in
-    let impl_path =
-      Switch_impl_intf.get_intf_impl_counterparts intf_path |> List.hd
-    in
-    let impl_uri = Uri.of_path impl_path in
+    let impl_uri = Document.get_impl_intf_counterparts intf_uri |> List.hd in
     let* impl =
       match Document_store.get_opt state.store impl_uri with
       | None -> force_open_document state impl_uri

ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.ml

@@ -0,0 +1,29 @@
+open Import
+
+let capability = ("handleSwitchImplIntf", `Bool true)
+
+let meth = "ocamllsp/switchImplIntf"
+
+(** see the spec for [ocamllsp/switchImplIntf] *)
+let switch (param : DocumentUri.t) : (Json.t, Jsonrpc.Response.Error.t) result =
+  let files_to_switch_to =
+    Document.get_impl_intf_counterparts (Uri.t_of_yojson (`String param))
+  in
+  Ok
+    (Json.yojson_of_list
+       (fun uri -> uri |> Uri.to_string |> fun s -> `String s)
+       files_to_switch_to)
+
+let on_request ~(params : Json.t option) state =
+  Fiber.return
+    ( match params with
+    | Some (`String (file_uri : DocumentUri.t)) ->
+      let open Result.O in
+      let+ res = switch file_uri in
+      (res, state)
+    | Some _
+    | None ->
+      Error
+        (Jsonrpc.Response.Error.make ~code:InvalidRequest
+           ~message:"ocamllsp/switchImplIntf must receive param : DocumentUri.t"
+           ()) )

ocaml-lsp-server/src/switch_impl_intf.mli → ocaml-lsp-server/src/custom_requests/req_switch_impl_intf.mli

@@ -4,8 +4,6 @@ val capability : string * Json.t
 
 val meth : string
 
-val get_intf_impl_counterparts : string -> string list
-
 val on_request :
      params:Json.t option
   -> State.t

ocaml-lsp-server/src/document.ml

@@ -145,3 +145,45 @@ let dispatch_exn (doc : t) command =
       Query_commands.dispatch pipeline command)
 
 let close t = Scheduler.cancel_timer t.timer
+
+let get_impl_intf_counterparts uri =
+  let uri_s = Uri.to_string uri in
+  let fpath =
+    match String.split ~on:':' uri_s with
+    | [ scheme; path ] ->
+      if scheme = "file" then
+        Uri.t_of_yojson (`String uri_s) |> Uri.to_path
+      else
+        path
+    | _ -> failwith "provided file URI (param) doesn't follow URI spec"
+  in
+  let fname = Filename.basename fpath in
+  let ml, mli, re, rei, mll, mly = ("ml", "mli", "re", "rei", "mll", "mly") in
+  let exts_to_switch_to =
+    match Syntax.of_fname fname with
+    | Ocaml -> (
+      match Kind.of_fname fname with
+      | Intf -> [ ml; mly; mll; re ]
+      | Impl -> [ mli; mly; mll; rei ] )
+    | Reason -> (
+      match Kind.of_fname fname with
+      | Intf -> [ re; ml ]
+      | Impl -> [ rei; mli ] )
+    | Ocamllex -> [ mli; rei ]
+    | Menhir -> [ mli; rei ]
+  in
+  let fpath_w_ext ext = Filename.remove_extension fpath ^ "." ^ ext in
+  let find_switch exts =
+    List.filter_map exts ~f:(fun ext ->
+        let file_to_switch_to = fpath_w_ext ext in
+        Option.some_if (Sys.file_exists file_to_switch_to) file_to_switch_to)
+  in
+  let files_to_switch_to =
+    match find_switch exts_to_switch_to with
+    | [] ->
+      let switch_to_ext = List.hd exts_to_switch_to in
+      let switch_to_fpath = fpath_w_ext switch_to_ext in
+      [ switch_to_fpath ]
+    | to_switch_to -> to_switch_to
+  in
+  List.map ~f:Uri.of_path files_to_switch_to

ocaml-lsp-server/src/document.mli

@@ -54,3 +54,9 @@ val dispatch : t -> 'a Query_protocol.t -> ('a, exn) result Fiber.t
 val dispatch_exn : t -> 'a Query_protocol.t -> 'a Fiber.t
 
 val close : t -> unit Fiber.t
+
+(** [get_impl_intf_counterparts uri] returns the implementation/interface
+    counterparts for the URI [uri].
+
+    For instance, the counterparts of the file {/file.ml} are {[/file.mli]}. *)
+val get_impl_intf_counterparts : Uri.t -> Uri.t list

ocaml-lsp-server/src/dune

@@ -7,3 +7,5 @@
    merlin.analysis merlin.kernel merlin.merlin_utils merlin.parsing
    merlin.query_commands merlin.query_protocol merlin.specific merlin.typing
    merlin.utils octavius omd ppx_yojson_conv_lib result stdune yojson))
+
+(include_subdirs unqualified)

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -15,8 +15,8 @@ let not_supported () =
 let initialize_info : InitializeResult.t =
   let codeActionProvider =
     let codeActionKinds =
-      [ CodeActionKind.Other Destruct.action_kind
-      ; CodeActionKind.Other Inferred_intf.action_kind
+      [ CodeActionKind.Other Action_destruct.action_kind
+      ; CodeActionKind.Other Action_inferred_intf.action_kind
       ]
     in
     `CodeActionOptions (CodeActionOptions.create ~codeActionKinds ())
@@ -43,7 +43,7 @@ let initialize_info : InitializeResult.t =
         [ ( "ocamllsp"
           , `Assoc
               [ ("interfaceSpecificLangId", `Bool true)
-              ; Switch_impl_intf.capability
+              ; Req_switch_impl_intf.capability
               ] )
         ]
     in
@@ -184,10 +184,10 @@ let code_action server (params : CodeActionParams.t) =
   let open Fiber.O in
   let+ code_action_results =
     Fiber.parallel_map ~f:code_action
-      [ ( CodeActionKind.Other Destruct.action_kind
-        , fun () -> Destruct.code_action doc params )
-      ; ( CodeActionKind.Other Inferred_intf.action_kind
-        , fun () -> Inferred_intf.code_action doc state params )
+      [ ( CodeActionKind.Other Action_destruct.action_kind
+        , fun () -> Action_destruct.code_action doc params )
+      ; ( CodeActionKind.Other Action_inferred_intf.action_kind
+        , fun () -> Action_inferred_intf.code_action doc state params )
       ]
   in
   let open Result.O in
@@ -662,7 +662,7 @@ let on_request :
   match req with
   | Client_request.UnknownRequest { meth; params } -> (
     match
-      [ (Switch_impl_intf.meth, Switch_impl_intf.on_request) ]
+      [ (Req_switch_impl_intf.meth, Req_switch_impl_intf.on_request) ]
       |> List.assoc_opt meth
     with
     | None ->