Skip to content

Commit

Permalink
Merge pull request #256 from rgrinberg/destruct-own-module
Browse files Browse the repository at this point in the history
Move destruct to own module
  • Loading branch information
rgrinberg authored Oct 8, 2020
2 parents 2d1e7c0 + b0673ec commit 59c9138
Show file tree
Hide file tree
Showing 3 changed files with 52 additions and 40 deletions.
34 changes: 34 additions & 0 deletions ocaml-lsp-server/src/destruct_lsp.ml
Original file line number Diff line number Diff line change
@@ -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) )
8 changes: 8 additions & 0 deletions ocaml-lsp-server/src/destruct_lsp.mli
Original file line number Diff line number Diff line change
@@ -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
50 changes: 10 additions & 40 deletions ocaml-lsp-server/src/ocaml_lsp_server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) =
Expand Down

0 comments on commit 59c9138

Please sign in to comment.