Merge pull request #256 from rgrinberg/destruct-own-module

Move destruct to own module

Author: rgrinberg

ocaml-lsp-server/src/destruct_lsp.ml

@@ -0,0 +1,34 @@
+open Import
+
+let action_kind = "destruct"
+
+let code_action_of_case_analysis uri (loc, newText) =
+  let edit : WorkspaceEdit.t =
+    let textedit : TextEdit.t = { range = Range.of_loc loc; newText } in
+    let uri = Uri.to_string uri in
+    WorkspaceEdit.create ~changes:[ (uri, [ textedit ]) ] ()
+  in
+  let title = String.capitalize_ascii action_kind in
+  CodeAction.create ~title ~kind:(CodeActionKind.Other action_kind) ~edit
+    ~isPreferred:false ()
+
+let code_action doc (params : CodeActionParams.t) =
+  let uri = Uri.t_of_yojson (`String params.textDocument.uri) in
+  match Document.kind doc with
+  | Intf -> Fiber.return (Ok None)
+  | Impl -> (
+    let command =
+      let start = Position.logical params.range.start in
+      let finish = Position.logical params.range.end_ in
+      Query_protocol.Case_analysis (start, finish)
+    in
+    let open Fiber.O in
+    let+ res = Document.dispatch doc command in
+    match res with
+    | Ok res -> Ok (Some (code_action_of_case_analysis uri res))
+    | Error
+        ( Destruct.Wrong_parent _ | Query_commands.No_nodes
+        | Destruct.Not_allowed _ | Destruct.Useless_refine
+        | Destruct.Nothing_to_do ) ->
+      Ok None
+    | Error exn -> Error (Jsonrpc.Response.Error.of_exn exn) )

ocaml-lsp-server/src/destruct_lsp.mli

@@ -0,0 +1,8 @@
+open Import
+
+val action_kind : string
+
+val code_action :
+     Document.t
+  -> CodeActionParams.t
+  -> (CodeAction.t option, Jsonrpc.Response.Error.t) Fiber.Result.t

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -12,14 +12,10 @@ let not_supported () =
   @@ Error
        (make_error ~code:InternalError ~message:"Request not supported yet!" ())
 
-module Action = struct
-  let destruct = "destruct"
-end
-
 let initialize_info : InitializeResult.t =
   let codeActionProvider =
-    `CodeActionOptions
-      (CodeActionOptions.create ~codeActionKinds:[ Other Action.destruct ] ())
+    let codeActionKinds = [ CodeActionKind.Other Destruct_lsp.action_kind ] in
+    `CodeActionOptions (CodeActionOptions.create ~codeActionKinds ())
   in
   let textDocumentSync =
     `TextDocumentSyncOptions
@@ -157,49 +153,23 @@ let on_initialize rpc =
   Logger.register_consumer log_consumer;
   initialize_info
 
-let code_action_of_case_analysis uri (loc, newText) =
-  let edit : WorkspaceEdit.t =
-    let textedit : TextEdit.t = { range = Range.of_loc loc; newText } in
-    let uri = Uri.to_string uri in
-    WorkspaceEdit.create ~changes:[ (uri, [ textedit ]) ] ()
-  in
-  let title = String.capitalize_ascii Action.destruct in
-  CodeAction.create ~title ~kind:(CodeActionKind.Other Action.destruct) ~edit
-    ~isPreferred:false ()
-
 let code_action server (params : CodeActionParams.t) =
   let state : State.t = Server.state server in
   let store = state.store in
   match params.context.only with
-  | Some set when not (List.mem (CodeActionKind.Other Action.destruct) ~set) ->
+  | Some set
+    when not (List.mem (CodeActionKind.Other Destruct_lsp.action_kind) ~set) ->
     Fiber.return (Ok (None, state))
   | Some _
-  | None -> (
+  | None ->
     let open Fiber.Result.O in
     let uri = Uri.t_of_yojson (`String params.textDocument.uri) in
     let* doc = Fiber.return (Document_store.get store uri) in
-    match Document.kind doc with
-    | Intf -> Fiber.return (Ok (None, state))
-    | Impl ->
-      let command =
-        let start = Position.logical params.range.start in
-        let finish = Position.logical params.range.end_ in
-        Query_protocol.Case_analysis (start, finish)
-      in
-      let+ result =
-        let open Fiber.O in
-        let+ res = Document.dispatch doc command in
-        match res with
-        | Ok res ->
-          Ok (Some [ `CodeAction (code_action_of_case_analysis uri res) ])
-        | Error
-            ( Destruct.Wrong_parent _ | Query_commands.No_nodes
-            | Destruct.Not_allowed _ | Destruct.Useless_refine
-            | Destruct.Nothing_to_do ) ->
-          Ok (Some [])
-        | Error exn -> raise exn
-      in
-      (result, state) )
+    let+ action = Destruct_lsp.code_action doc params in
+    let action =
+      Option.map action ~f:(fun destruct -> [ `CodeAction destruct ])
+    in
+    (action, state)
 
 module Formatter = struct
   let jsonrpc_error (e : Fmt.error) =