diff --git a/src/lsp/cobol_lsp/cobol_lsp.ml b/src/lsp/cobol_lsp/alltypes.ml similarity index 54% rename from src/lsp/cobol_lsp/cobol_lsp.ml rename to src/lsp/cobol_lsp/alltypes.ml index d94955588..119389ed3 100644 --- a/src/lsp/cobol_lsp/cobol_lsp.ml +++ b/src/lsp/cobol_lsp/alltypes.ml @@ -11,32 +11,10 @@ (* *) (**************************************************************************) -include Lsp_server_loop - -(* --- *) - -(** {1 Modules and functions exported for testing purposes} - - Signatures of modules below may change unexpectedly. *) - -module INTERNAL = struct - module Types = struct - include Lsp_imports - include Lsp_diagnostics.TYPES - include Lsp_lookup.TYPES - include Lsp_document.TYPES - include Lsp_project.TYPES - include Lsp_project_cache.TYPES - include Lsp_server.TYPES - end - module Diagnostics = Lsp_diagnostics - module Lookup = Lsp_lookup - module Project = Lsp_project - module Project_cache = Lsp_project_cache - module Document = Lsp_document - module Server = Lsp_server - module Loop = Lsp_server_loop - module Request = Lsp_request.INTERNAL - module Utils = Lsp_utils - module Debug = Lsp_debug -end +include Lsp_imports +include Diagnostics.TYPES +include Lookup.TYPES +include Document.TYPES +include Project.TYPES +include Project_cache.TYPES +include Server.TYPES diff --git a/src/lsp/cobol_lsp/lsp_diagnostics.ml b/src/lsp/cobol_lsp/diagnostics.ml similarity index 96% rename from src/lsp/cobol_lsp/lsp_diagnostics.ml rename to src/lsp/cobol_lsp/diagnostics.ml index 0908a54af..32a2db246 100644 --- a/src/lsp/cobol_lsp/lsp_diagnostics.ml +++ b/src/lsp/cobol_lsp/diagnostics.ml @@ -44,9 +44,9 @@ let translate_one ~rootdir ~uri (diag: DIAG.t) = let uri, range = match Option.map project_srcloc (DIAG.location diag) with | Some (Lexing.{ pos_fname = f; _ }, _ as lexloc) -> - pseudo_normalized_uri ~rootdir f, Lsp_position.range_of_lexloc lexloc + pseudo_normalized_uri ~rootdir f, Position.range_of_lexloc lexloc | None -> - uri, Lsp_position.pointwise_range_at_start + uri, Position.pointwise_range_at_start in let diag = Lsp.Types.Diagnostic.create () diff --git a/src/lsp/cobol_lsp/lsp_diagnostics.mli b/src/lsp/cobol_lsp/diagnostics.mli similarity index 100% rename from src/lsp/cobol_lsp/lsp_diagnostics.mli rename to src/lsp/cobol_lsp/diagnostics.mli diff --git a/src/lsp/cobol_lsp/lsp_document.ml b/src/lsp/cobol_lsp/document.ml similarity index 96% rename from src/lsp/cobol_lsp/lsp_document.ml rename to src/lsp/cobol_lsp/document.ml index 3c4aff173..46ff390bf 100644 --- a/src/lsp/cobol_lsp/lsp_document.ml +++ b/src/lsp/cobol_lsp/document.ml @@ -11,7 +11,7 @@ (* *) (**************************************************************************) -open Lsp_project.TYPES +open Project.TYPES open Ez_file.V1 module DIAGS = Cobol_common.Diagnostics @@ -20,7 +20,7 @@ module TYPES = struct type document = { - project: Lsp_project.t; + project: Project.t; textdoc: Lsp.Text_document.t; copybook: bool; artifacts: Cobol_parser.Outputs.artifacts; @@ -75,7 +75,7 @@ let rewindable_parse ({ project; textdoc; _ } as doc) = Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ default with - libpath = Lsp_project.libpath_for ~uri:(uri doc) project; + libpath = Project.libpath_for ~uri:(uri doc) project; config = project.config.cobol_config; source_format = project.config.source_format } @@ @@ -123,7 +123,7 @@ let reparse_and_analyze ?position ({ copybook; rewinder; textdoc; _ } as doc) = let blank ~project ?copybook textdoc = let copybook = match copybook with | Some p -> p - | None -> Lsp_project.detect_copybook project + | None -> Project.detect_copybook project ~uri:(Lsp.Text_document.documentUri textdoc) in { @@ -180,7 +180,7 @@ let to_cache ({ project; textdoc; checked; diags; artifacts = { pplog; tokens; rev_comments; rev_ignored; _ }; _ } as doc) = { - doc_cache_filename = Lsp_project.relative_path_for ~uri:(uri doc) project; + doc_cache_filename = Project.relative_path_for ~uri:(uri doc) project; doc_cache_checksum = Digest.string (Lsp.Text_document.text textdoc); doc_cache_langid = Lsp.Text_document.languageId textdoc; doc_cache_version = Lsp.Text_document.version textdoc; @@ -206,7 +206,7 @@ let of_cache ~project doc_cache_ignored = rev_ignored; doc_cache_checked = checked; doc_cache_diags = diags } = - let absolute_filename = Lsp_project.absolute_path_for ~filename project in + let absolute_filename = Project.absolute_path_for ~filename project in if checksum <> Digest.file absolute_filename then failwith "Bad checksum" else diff --git a/src/lsp/cobol_lsp/lsp_lookup.ml b/src/lsp/cobol_lsp/lookup.ml similarity index 96% rename from src/lsp/cobol_lsp/lsp_lookup.ml rename to src/lsp/cobol_lsp/lookup.ml index 051b7e6fb..cc5d5fbc8 100644 --- a/src/lsp/cobol_lsp/lsp_lookup.ml +++ b/src/lsp/cobol_lsp/lookup.ml @@ -92,8 +92,8 @@ let rec qualname_at_pos ~filename (qn: Cobol_ptree.Types.qualname) pos = | Qual (name, qn') -> try let lexloc = lexloc_of_qualname_in ~filename qn in - if not (Lsp_position.is_after_lexloc pos lexloc) && - not (Lsp_position.is_in_srcloc ~filename pos ~@name) + if not (Position.is_after_lexloc pos lexloc) && + not (Position.is_in_srcloc ~filename pos ~@name) then qualname_at_pos ~filename qn' pos else qn with Invalid_argument _ -> qn (* dummy loc *) @@ -151,7 +151,7 @@ let element_at_position ~uri pos group : element_at_position = Cobol_unit.Visitor.fold_unit_group object inherit [acc] Cobol_unit.Visitor.folder - inherit! [acc] Lsp_position.sieve ~filename ~pos + inherit! [acc] Position.sieve ~filename ~pos method! fold_cobol_unit' cu ({ elt; _ } as acc) = let name = ~&(~&cu.unit_name) in @@ -197,7 +197,7 @@ let copy_at_pos ~filename pos ptree = | None -> match Cobol_common.Srcloc.as_copy loc with | Some { loc; _ } as copy - when Lsp_position.is_in_srcloc ~filename pos loc -> + when Position.is_in_srcloc ~filename pos loc -> Visitor.skip_children copy | _ -> Visitor.do_children None diff --git a/src/lsp/cobol_lsp/lsp_server_loop.ml b/src/lsp/cobol_lsp/loop.ml similarity index 92% rename from src/lsp/cobol_lsp/lsp_server_loop.ml rename to src/lsp/cobol_lsp/loop.ml index 5611893fc..bb004f4ab 100644 --- a/src/lsp/cobol_lsp/lsp_server_loop.ml +++ b/src/lsp/cobol_lsp/loop.ml @@ -31,11 +31,11 @@ open Ez_file.V1.EzFile.OP [project_layout] does not provide a per-project storage directory ({i i.e,} [project_layout.relative_work_dirname = None]). *) let config - ~(project_layout: Lsp_project.layout) + ~(project_layout: Project.layout) ?(enable_caching = true) ?(fallback_storage_directory: string option) () = - let cache_storage: Lsp_project_cache.storage = + let cache_storage: Project_cache.storage = match project_layout.relative_work_dirname, fallback_storage_directory with | _ when not enable_caching -> No_storage @@ -57,7 +57,7 @@ let config relative_filename = relative_work_dirname // "lsp-cache"; } in - Lsp_server.{ + Server.{ cache_config = { cache_storage; cache_verbose = true; @@ -76,14 +76,14 @@ let run ~config = | Jsonrpc.Packet.Notification n -> continue @@ Lsp_notif.handle n state | Jsonrpc.Packet.Request r -> - continue @@ reply @@ Lsp_request.handle r state + continue @@ reply @@ Request.handle r state | Jsonrpc.Packet.Batch_call calls -> batch calls state | Jsonrpc.Packet.Response _ | Batch_response _ -> Pretty.error "Response@ recieved@ unexpectedly@."; continue state | exception End_of_file -> - Lsp_request.shutdown state; + Request.shutdown state; Error "Premature end of input stream" (* exit loop *) | exception Lsp_io.Parse_error msg -> Lsp_io.pretty_notification ~type_:Error "%s" msg; @@ -95,12 +95,12 @@ let run ~config = | `Notification n :: calls' -> batch calls' @@ Lsp_notif.handle n state | `Request n :: calls' -> - batch calls' @@ reply @@ Lsp_request.handle n state + batch calls' @@ reply @@ Request.handle n state and reply (state, response) = Lsp_io.send_response response; state and continue = function - | Lsp_server.Exit code -> code (* exit loop *) + | Server.Exit code -> code (* exit loop *) | state -> loop state in loop (NotInitialized config) diff --git a/src/lsp/cobol_lsp/lsp_server_loop.mli b/src/lsp/cobol_lsp/loop.mli similarity index 92% rename from src/lsp/cobol_lsp/lsp_server_loop.mli rename to src/lsp/cobol_lsp/loop.mli index 7bbfeb5d7..c618b8cb9 100644 --- a/src/lsp/cobol_lsp/lsp_server_loop.mli +++ b/src/lsp/cobol_lsp/loop.mli @@ -16,8 +16,8 @@ val config -> ?enable_caching: bool -> ?fallback_storage_directory: string -> unit - -> Lsp_server.config + -> Server.config val run - : config: Lsp_server.config - -> Lsp_server.exit_status + : config: Server.config + -> Server.exit_status diff --git a/src/lsp/cobol_lsp/lsp_completion.ml b/src/lsp/cobol_lsp/lsp_completion.ml index d1e01d418..e6a7d1d21 100644 --- a/src/lsp/cobol_lsp/lsp_completion.ml +++ b/src/lsp/cobol_lsp/lsp_completion.ml @@ -17,14 +17,15 @@ open Cobol_common (* Visitor *) open Cobol_common.Srcloc.INFIX open Lsp_completion_keywords -open Lsp.Types + +module POSITION = Lsp.Types.Position let name_proposals ast ~filename pos = let visitor = object inherit [StringSet.t] Cobol_ptree.Visitor.folder method! fold_compilation_unit' cu = - if Lsp_position.is_in_srcloc ~filename pos ~@cu + if Position.is_in_srcloc ~filename pos ~@cu then Visitor.do_children else Visitor.skip_children @@ -56,13 +57,13 @@ let keyword_proposals ast pos = method! fold_data_division' {loc; _} _ = Visitor.skip_children @@ - if Lsp_position.is_in_srcloc pos loc + if Position.is_in_srcloc pos loc then Some Data_div else None method! fold_procedure_division' {loc; _} _ = Visitor.skip_children @@ - if Lsp_position.is_in_srcloc pos loc + if Position.is_in_srcloc pos loc then Some Proc_div else None @@ -75,7 +76,7 @@ let keyword_proposals ast pos = let keyword_proposals _ast _pos = keywords_all -let completion_items text (pos:Position.t) ast = +let completion_items text (pos:POSITION.t) ast = let filename = Lsp.Uri.to_path (Lsp.Text_document.documentUri text) in let range = let line = pos.line in @@ -83,8 +84,8 @@ let completion_items text (pos:Position.t) ast = let texts = String.split_on_char '\n' @@ Lsp.Text_document.text text in let text_line = List.nth texts line in let index = 1 + String.rindex_from text_line (character - 1) ' ' in - let position_start = Position.create ~character:index ~line in - Range.create ~start:position_start ~end_:pos + let position_start = POSITION.create ~character:index ~line in + Lsp.Types.Range.create ~start:position_start ~end_:pos in let names = name_proposals ast ~filename pos in @@ -92,9 +93,9 @@ let completion_items text (pos:Position.t) ast = let words = names @ keywords in List.map (fun x -> - let textedit = TextEdit.create ~newText:x ~range in + let textedit = Lsp.Types.TextEdit.create ~newText:x ~range in (*we may change the ~sortText/preselect for reason of priority *) - CompletionItem.create + Lsp.Types.CompletionItem.create ~label:x ~sortText:x ~preselect:false diff --git a/src/lsp/cobol_lsp/lsp_notif.ml b/src/lsp/cobol_lsp/lsp_notif.ml index 07bec7eda..c4bd6b579 100644 --- a/src/lsp/cobol_lsp/lsp_notif.ml +++ b/src/lsp/cobol_lsp/lsp_notif.ml @@ -11,7 +11,7 @@ (* *) (**************************************************************************) -open Lsp_server.TYPES +open Server.TYPES let on_notification state notif = match state, notif with @@ -22,15 +22,15 @@ let on_notification state notif = | NotInitialized _ | Exit _ as state, _ -> state (* spec indicate notif should just be discarded *) | Initialized config, Initialized -> - Running (Lsp_server.init ~config) + Running (Server.init ~config) | Running registry, TextDocumentDidOpen params -> - Running (Lsp_server.did_open params registry) + Running (Server.did_open params registry) | Running registry, TextDocumentDidChange params -> - Running (Lsp_server.did_change params registry) + Running (Server.did_change params registry) | Running registry, TextDocumentDidClose params -> - Running (Lsp_server.did_close params registry) + Running (Server.did_close params registry) | Running _, Exit -> - Lsp_request.shutdown state; + Request.shutdown state; Exit (Error "Received premature 'exit' notification") | _ -> state @@ -42,7 +42,7 @@ let handle notif state = state | Ok notif -> try on_notification state notif with - | Lsp_server.Document_not_found { uri } -> + | Server.Document_not_found { uri } -> Lsp_io.pretty_notification ~type_:Error "Document@ %s@ is@ not@ opened@ yet" (Lsp.Types.DocumentUri.to_string uri); diff --git a/src/lsp/cobol_lsp/lsp_notif.mli b/src/lsp/cobol_lsp/lsp_notif.mli index 3a3b4c299..7f944c36a 100644 --- a/src/lsp/cobol_lsp/lsp_notif.mli +++ b/src/lsp/cobol_lsp/lsp_notif.mli @@ -11,4 +11,4 @@ (* *) (**************************************************************************) -val handle: Jsonrpc.Notification.t -> (Lsp_server.state as 's) -> 's +val handle: Jsonrpc.Notification.t -> (Server.state as 's) -> 's diff --git a/src/lsp/cobol_lsp/lsp_semtoks.ml b/src/lsp/cobol_lsp/lsp_semtoks.ml index 010173ecc..12a33049a 100644 --- a/src/lsp/cobol_lsp/lsp_semtoks.ml +++ b/src/lsp/cobol_lsp/lsp_semtoks.ml @@ -98,7 +98,7 @@ type semtok = { } let semtok ?(tokmods = TOKMOD.none) toktyp lexloc = - let range = Lsp_position.range_of_lexloc lexloc in + let range = Position.range_of_lexloc lexloc in let line = range.start.line in let start = range.start.character in let length = range.end_.character - start in @@ -109,7 +109,7 @@ let single_line_lexlocs_in ~filename = let acc_semtoks ~filename ?range ?tokmods toktyp loc acc = List.fold_left begin fun acc lexloc -> match range with - | Some r when not (Lsp_position.intersects_lexloc r lexloc) -> acc + | Some r when not (Position.intersects_lexloc r lexloc) -> acc | _ -> semtok toktyp ?tokmods lexloc :: acc end acc @@ single_line_lexlocs_in ~filename loc @@ -548,7 +548,7 @@ let semtoks_of_comments ~filename ?range rev_comments = | Cobol_preproc.Text.{ comment_loc = s, _ as lexloc; _ } when s.Lexing.pos_fname = filename && Option.fold range - ~some:(fun r -> Lsp_position.intersects_lexloc r lexloc) + ~some:(fun r -> Position.intersects_lexloc r lexloc) ~none:true -> semtok TOKTYP.comment lexloc :: acc | _ -> @@ -563,7 +563,7 @@ let semtoks_of_ignored ~filename ?range rev_ignored = List.fold_left begin fun acc ((s, _ ) as lexloc) -> if s.Lexing.pos_fname = filename && Option.fold range - ~some:(fun r -> Lsp_position.intersects_lexloc r lexloc) + ~some:(fun r -> Position.intersects_lexloc r lexloc) ~none:true then semtok TOKTYP.comment lexloc :: acc else acc diff --git a/src/lsp/cobol_lsp/lsp_position.ml b/src/lsp/cobol_lsp/position.ml similarity index 100% rename from src/lsp/cobol_lsp/lsp_position.ml rename to src/lsp/cobol_lsp/position.ml diff --git a/src/lsp/cobol_lsp/lsp_position.mli b/src/lsp/cobol_lsp/position.mli similarity index 100% rename from src/lsp/cobol_lsp/lsp_position.mli rename to src/lsp/cobol_lsp/position.mli diff --git a/src/lsp/cobol_lsp/lsp_project.ml b/src/lsp/cobol_lsp/project.ml similarity index 97% rename from src/lsp/cobol_lsp/lsp_project.ml rename to src/lsp/cobol_lsp/project.ml index d5094ad09..7195e5546 100644 --- a/src/lsp/cobol_lsp/lsp_project.ml +++ b/src/lsp/cobol_lsp/project.ml @@ -36,8 +36,8 @@ let rootdir_for ~uri ~layout = let show_n_forget_diagnostics ?(force = false) { result = project; diags } = if force || diags <> DIAGS.Set.none then - Lsp_diagnostics.publish @@ - Lsp_diagnostics.translate diags + Diagnostics.publish @@ + Diagnostics.translate diags ~rootdir:(Superbol_project.string_of_rootdir project.rootdir) ~uri:(`Main (Lsp.Uri.of_path project.config_filename)); project diff --git a/src/lsp/cobol_lsp/lsp_project.mli b/src/lsp/cobol_lsp/project.mli similarity index 100% rename from src/lsp/cobol_lsp/lsp_project.mli rename to src/lsp/cobol_lsp/project.mli diff --git a/src/lsp/cobol_lsp/lsp_project_cache.ml b/src/lsp/cobol_lsp/project_cache.ml similarity index 81% rename from src/lsp/cobol_lsp/lsp_project_cache.ml rename to src/lsp/cobol_lsp/project_cache.ml index 4c45b8028..388294cd9 100644 --- a/src/lsp/cobol_lsp/lsp_project_cache.ml +++ b/src/lsp/cobol_lsp/project_cache.ml @@ -37,7 +37,7 @@ include TYPES opened document pertaining to a given project. *) module CACHED_DOCS = Set.Make (struct - open Lsp_document.TYPES + open Document.TYPES type t = cached let compare { doc_cache_filename = f1; _ } { doc_cache_filename = f2; _ } = String.compare f1 f2 @@ -45,7 +45,7 @@ module CACHED_DOCS = type cached_project_record = { - cached_project: Lsp_project.cached; + cached_project: Project.cached; cached_docs: CACHED_DOCS.t; } @@ -56,10 +56,10 @@ let cache_filename ~config ~rootdir = | No_storage -> None | Store_in_file { relative_filename } -> - Some (Lsp_project.string_of_rootdir rootdir // relative_filename) + Some (Project.string_of_rootdir rootdir // relative_filename) | Store_in_shared_dir { dirname } -> Some (dirname // Digest.(to_hex @@ - string @@ Lsp_project.string_of_rootdir rootdir)) + string @@ Project.string_of_rootdir rootdir)) let version_tag_length = 40 (* use full commit hash when available *) let version_tag = @@ -84,10 +84,10 @@ let read_project_cache ic = (** (Internal) May raise {!Failure} or {!Sys_error}. *) let save_project_cache ~config - (Lsp_project.{ rootdir; _ } as project) cached_docs = + (Project.{ rootdir; _ } as project) cached_docs = let cached_project_record = { - cached_project = Lsp_project.to_cache project; + cached_project = Project.to_cache project; cached_docs; } in @@ -98,7 +98,7 @@ let save_project_cache ~config (* if Lsp_utils.is_file cache_file *) (* then (* read, write if commit hash or document changed *) *) (* else *) - Lsp_utils.write_to cache_file (write_project_cache cached_project_record); + Utils.write_to cache_file (write_project_cache cached_project_record); Lsp_io.pretty_notification "Wrote cache at: %s" cache_file ~log:true ~type_:Info | None -> @@ -107,24 +107,24 @@ let save_project_cache ~config let save ~config docs = (* Pivot all active projects: associate projects with all their documents, and ignore any project that has none. *) - URIMap.fold begin fun _ (Lsp_document.{ project; _ } as doc) -> - Lsp_project.MAP.update project begin function - | None -> Some (CACHED_DOCS.singleton (Lsp_document.to_cache doc)) - | Some s -> Some (CACHED_DOCS.add (Lsp_document.to_cache doc) s) + URIMap.fold begin fun _ (Document.{ project; _ } as doc) -> + Project.MAP.update project begin function + | None -> Some (CACHED_DOCS.singleton (Document.to_cache doc)) + | Some s -> Some (CACHED_DOCS.add (Document.to_cache doc) s) end - end docs Lsp_project.MAP.empty |> - Lsp_project.MAP.iter (save_project_cache ~config) + end docs Project.MAP.empty |> + Project.MAP.iter (save_project_cache ~config) (** (Internal) *) let load_project ~rootdir ~layout ~config { cached_project; cached_docs; _ } = - let project = Lsp_project.of_cache ~rootdir ~layout cached_project in - let add_doc doc docs = URIMap.add (Lsp_document.uri doc) doc docs in + let project = Project.of_cache ~rootdir ~layout cached_project in + let add_doc doc docs = URIMap.add (Document.uri doc) doc docs in CACHED_DOCS.fold begin fun cached_doc docs -> try - let doc = Lsp_document.of_cache ~project cached_doc in + let doc = Document.of_cache ~project cached_doc in if config.cache_verbose then Lsp_io.pretty_notification "Successfully read cache for %s" - (Lsp.Uri.to_string @@ Lsp_document.uri doc) ~log:true ~type_:Info; + (Lsp.Uri.to_string @@ Document.uri doc) ~log:true ~type_:Info; add_doc doc docs with | Failure msg | Sys_error msg -> @@ -141,10 +141,10 @@ let load_project ~rootdir ~layout ~config { cached_project; cached_docs; _ } = let load ~rootdir ~layout ~config = let fallback = URIMap.empty in let load_cache cache_file = - let cached_project = Lsp_utils.read_from cache_file read_project_cache in + let cached_project = Utils.read_from cache_file read_project_cache in let project = load_project ~rootdir ~layout ~config cached_project in Lsp_io.pretty_notification "Successfully read cache for %s" - (Lsp_project.string_of_rootdir rootdir) ~log:true ~type_:Info; + (Project.string_of_rootdir rootdir) ~log:true ~type_:Info; project in match cache_filename ~config ~rootdir with diff --git a/src/lsp/cobol_lsp/lsp_project_cache.mli b/src/lsp/cobol_lsp/project_cache.mli similarity index 95% rename from src/lsp/cobol_lsp/lsp_project_cache.mli rename to src/lsp/cobol_lsp/project_cache.mli index b080ef83d..7d7fff607 100644 --- a/src/lsp/cobol_lsp/lsp_project_cache.mli +++ b/src/lsp/cobol_lsp/project_cache.mli @@ -48,7 +48,7 @@ include module type of TYPES ([Sys_error], [Failure]). *) val save : config: TYPES.config - -> Lsp_document.t URIMap.t + -> Document.t URIMap.t -> unit (** [load ~rootdir ~config ~layout] pre-loads cached documents pertaining to a @@ -62,7 +62,7 @@ val save {!Lsp_io.send_notification}. May raise some IO-related exceptions ([Sys_error], [Failure]). *) val load - : rootdir:Lsp_project.rootdir - -> layout: Lsp_project.layout + : rootdir:Project.rootdir + -> layout: Project.layout -> config: TYPES.config - -> Lsp_document.t URIMap.t + -> Document.t URIMap.t diff --git a/src/lsp/cobol_lsp/lsp_request.ml b/src/lsp/cobol_lsp/request.ml similarity index 86% rename from src/lsp/cobol_lsp/lsp_request.ml rename to src/lsp/cobol_lsp/request.ml index 8ac96986c..77f2e20de 100644 --- a/src/lsp/cobol_lsp/lsp_request.ml +++ b/src/lsp/cobol_lsp/request.ml @@ -14,10 +14,9 @@ open Cobol_common.Srcloc.TYPES open Cobol_common.Srcloc.INFIX open Lsp_imports -open Lsp_project.TYPES -open Lsp_server.TYPES -open Lsp_lookup.TYPES -open Lsp.Types +open Project.TYPES +open Server.TYPES +open Lookup.TYPES open Ez_file.V1 (** {2 Handling requests} *) @@ -25,13 +24,14 @@ open Ez_file.V1 (** Catch generic exception cases, and report errors using {!error} above *) let try_doc ~f registry doc_id = let doc = - try Lsp_server.find_document doc_id registry + try Server.find_document doc_id registry with Not_found -> Lsp_error.request_failed "Received a request about a document that has not been opened yet (uri = \ %s) --- possible cause is the client did not manage to send the didOpen \ notification; this may happen due to unhandled character encodings.\ - " (DocumentUri.to_string doc_id.TextDocumentIdentifier.uri) + " (Lsp.Types.DocumentUri.to_string + doc_id.Lsp.Types.TextDocumentIdentifier.uri) in try f ~doc with e -> @@ -39,24 +39,24 @@ let try_doc ~f registry doc_id = (** Same as [try_doc], with some additional document data *) let try_with_document_data ~f = - try_doc ~f:(fun ~doc -> f ~doc @@ Lsp_document.checked doc) + try_doc ~f:(fun ~doc -> f ~doc @@ Document.checked doc) (** {3 Initialization} *) -let handle_initialize (params: InitializeParams.t) = - InitializeResult.create () +let handle_initialize (params: Lsp.Types.InitializeParams.t) = + Lsp.Types.InitializeResult.create () ~capabilities:(Lsp_capabilities.reply params.capabilities) (** {3 Shutdown} *) let handle_shutdown registry = - Lsp_server.save_project_caches registry + Server.save_project_caches registry (** {3 Definitions} *) let focus_on_name_in_defintions = true -let find_data_definition Lsp_position.{ location_of; location_of_srcloc } +let find_data_definition Position.{ location_of; location_of_srcloc } ?(allow_notifications = true) (qn: Cobol_ptree.Types.qualname) (cu: Cobol_unit.Types.cobol_unit) = match Cobol_unit.Qualmap.find qn cu.unit_data.data_items.named with @@ -88,7 +88,7 @@ let find_data_definition Lsp_position.{ location_of; location_of_srcloc } [] let find_proc_definition - Lsp_position.{ location_of; _ } + Position.{ location_of; _ } ?(allow_notifications = true) ?(in_section: Cobol_unit.Types.procedure_section option) (qn: Cobol_ptree.Types.qualname) (cu: Cobol_unit.Types.cobol_unit) = @@ -129,19 +129,19 @@ let find_definitions ?allow_notifications loc_translator with Not_found -> [] let lookup_definition_in_doc - DefinitionParams.{ textDocument = doc; position; _ } + Lsp.Types.DefinitionParams.{ textDocument = doc; position; _ } Cobol_typeck.Outputs.{ group; _ } = - match Lsp_lookup.element_at_position ~uri:doc.uri position group with + match Lookup.element_at_position ~uri:doc.uri position group with | { element_at_position = None; _ } | { enclosing_compilation_unit_name = None; _ } -> None | { element_at_position = Some qn; enclosing_compilation_unit_name = Some cu_name } -> - let loc_translator = Lsp_position.loc_translator doc in + let loc_translator = Position.loc_translator doc in Some (`Location (find_definitions loc_translator cu_name qn group)) -let handle_definition registry (params: DefinitionParams.t) = +let handle_definition registry (params: Lsp.Types.DefinitionParams.t) = try_with_document_data registry params.textDocument ~f:(fun ~doc:_ -> lookup_definition_in_doc params) @@ -168,10 +168,10 @@ let find_proc_qn ~kind qn ?in_section cu = end let lookup_references_in_doc - ReferenceParams.{ textDocument = doc; position; context; _ } + Lsp.Types.ReferenceParams.{ textDocument = doc; position; context; _ } Cobol_typeck.Outputs.{ group; artifacts = { references }; _ } = - match Lsp_lookup.element_at_position ~uri:doc.uri position group with + match Lookup.element_at_position ~uri:doc.uri position group with | { element_at_position = None; _ } -> Lsp_debug.message "Lsp_request.lookup_references_in_doc: element_at_position = None"; None @@ -180,8 +180,8 @@ let lookup_references_in_doc None | { element_at_position = Some qn; enclosing_compilation_unit_name = Some cu_name } -> - let Lsp_position.{ location_of_srcloc; _ } as loc_translator - = Lsp_position.loc_translator doc in + let Position.{ location_of_srcloc; _ } as loc_translator + = Position.loc_translator doc in let def_locs = if context.includeDeclaration then find_definitions ~allow_notifications:false loc_translator @@ -218,7 +218,7 @@ let lookup_references_in_doc in Some (def_locs @ ref_locs) -let handle_references state (params: ReferenceParams.t) = +let handle_references state (params: Lsp.Types.ReferenceParams.t) = try_with_document_data state params.textDocument ~f:(fun ~doc:_ -> lookup_references_in_doc params) @@ -226,16 +226,16 @@ let handle_references state (params: ReferenceParams.t) = let lsp_text_edit Cobol_indent.Types.{ lnum; offset_orig; offset_modif } = let delta = offset_modif - offset_orig in - let position = Position.create ~line:(lnum - 1) ~character:offset_orig in - let range = Range.create ~start:position ~end_:position in + let position = Lsp.Types.Position.create ~line:(lnum - 1) ~character:offset_orig in + let range = Lsp.Types.Range.create ~start:position ~end_:position in if delta > 0 then - TextEdit.create ~newText:(String.make delta ' ') ~range + Lsp.Types.TextEdit.create ~newText:(String.make delta ' ') ~range else let start = - Position.create ~line:(lnum - 1) ~character:(offset_orig + delta) + Lsp.Types.Position.create ~line:(lnum - 1) ~character:(offset_orig + delta) in - let range = Range.create ~start ~end_:position in - TextEdit.create ~newText:"" ~range + let range = Lsp.Types.Range.create ~start ~end_:position in + Lsp.Types.TextEdit.create ~newText:"" ~range (*Remark: The first line of the text selected to RangeFormatting must be @@ -244,10 +244,10 @@ let lsp_text_edit Cobol_indent.Types.{ lnum; offset_orig; offset_modif } = Otherwise, unexpected result. *) let handle_range_formatting registry params = - let open DocumentRangeFormattingParams in + let open Lsp.Types.DocumentRangeFormattingParams in let { textDocument = doc; range = {start; end_}; _ } = params in - let Lsp_document.{ project; textdoc; _ } = - Lsp_server.find_document doc registry + let Document.{ project; textdoc; _ } = + Server.find_document doc registry in let range_to_indent = Cobol_indent.Types.{ @@ -267,9 +267,9 @@ let handle_range_formatting registry params = Some (List.map lsp_text_edit edit_list) let handle_formatting registry params = - let DocumentFormattingParams.{ textDocument = doc; _ } = params in - let Lsp_document.{ project; textdoc; _ } = - Lsp_server.find_document doc registry in + let Lsp.Types.DocumentFormattingParams.{ textDocument = doc; _ } = params in + let Document.{ project; textdoc; _ } = + Server.find_document doc registry in try let editList = Cobol_indent.Indent_main.indent_range @@ -288,7 +288,7 @@ let handle_formatting registry params = let handle_semtoks_full, handle_semtoks_range = - let handle registry ?range (doc: TextDocumentIdentifier.t) = + let handle registry ?range (doc: Lsp.Types.TextDocumentIdentifier.t) = try_with_document_data registry doc ~f:begin fun ~doc:{ artifacts = { pplog; tokens; rev_comments; rev_ignored; _ }; @@ -298,17 +298,17 @@ let handle_semtoks_full, ~pplog ~rev_comments ~rev_ignored ~tokens:(Lazy.force tokens) ~ptree in - Some (SemanticTokens.create ~data ()) + Some (Lsp.Types.SemanticTokens.create ~data ()) end in - (fun registry (SemanticTokensParams.{ textDocument; _ }) -> + (fun registry (Lsp.Types.SemanticTokensParams.{ textDocument; _ }) -> handle registry textDocument), - (fun registry (SemanticTokensRangeParams.{ textDocument; range; _ }) -> + (fun registry (Lsp.Types.SemanticTokensRangeParams.{ textDocument; range; _ }) -> handle registry ~range textDocument) (** {3 Hover} *) -let handle_hover registry (params: HoverParams.t) = +let handle_hover registry (params: Lsp.Types.HoverParams.t) = let filename = Lsp.Uri.to_path params.textDocument.uri in let find_hovered_pplog_event pplog = List.find_opt begin function @@ -317,14 +317,14 @@ let handle_hover registry (params: HoverParams.t) = false | Replacement { matched_loc = loc; _ } | FileCopy { copyloc = loc; _ } -> - Lsp_position.is_in_lexloc params.position + Position.is_in_lexloc params.position (Cobol_common.Srcloc.lexloc_in ~filename loc) end (Cobol_preproc.Trace.events pplog) in let hover_markdown ~loc value = - let content = MarkupContent.create ~kind:MarkupKind.Markdown ~value in - let range = Lsp_position.range_of_srcloc_in ~filename loc in - Some (Hover.create () ~contents:(`MarkupContent content) ~range) + let content = Lsp.Types.MarkupContent.create ~kind:Lsp.Types.MarkupKind.Markdown ~value in + let range = Position.range_of_srcloc_in ~filename loc in + Some (Lsp.Types.Hover.create () ~contents:(`MarkupContent content) ~range) in try_doc registry params.textDocument ~f:begin fun ~doc:{ project; artifacts = { pplog; _ }; _ } -> @@ -352,12 +352,12 @@ let handle_hover registry (params: HoverParams.t) = (** {3 Completion} *) -let handle_completion registry (params: CompletionParams.t) = +let handle_completion registry (params: Lsp.Types.CompletionParams.t) = try_with_document_data registry params.textDocument ~f:begin fun ~doc:{ textdoc; _ } { ptree; _ } -> let items = Lsp_completion.completion_items textdoc params.position ptree in - Some (`CompletionList (CompletionList.create () + Some (`CompletionList (Lsp.Types.CompletionList.create () ~isIncomplete:false ~items)) end @@ -368,7 +368,7 @@ let handle_completion registry (params: CompletionParams.t) = It only supports folding complete lines, and does not support FoldingRangeKind or CollapsedText (To support these features, need to change the client capability) *) -let handle_folding_range registry (params: FoldingRangeParams.t) = +let handle_folding_range registry (params: Lsp.Types.FoldingRangeParams.t) = try_with_document_data registry params.textDocument ~f:begin fun ~doc:_ { ptree; group; _ } -> let filename = Lsp.Uri.to_path params.textDocument.uri in @@ -474,7 +474,7 @@ let handle (Jsonrpc.Request.{ id; _ } as req) state = | Error server_error -> state, Jsonrpc.Response.error id @@ - Lsp_server.jsonrpc_of_error server_error req.method_ + Server.jsonrpc_of_error server_error req.method_ | exception Jsonrpc.Response.Error.E e -> state, Jsonrpc.Response.error id e | exception e -> diff --git a/src/lsp/cobol_lsp/lsp_request.mli b/src/lsp/cobol_lsp/request.mli similarity index 85% rename from src/lsp/cobol_lsp/lsp_request.mli rename to src/lsp/cobol_lsp/request.mli index 64e42b9eb..a89fc01d0 100644 --- a/src/lsp/cobol_lsp/lsp_request.mli +++ b/src/lsp/cobol_lsp/request.mli @@ -11,32 +11,32 @@ (* *) (**************************************************************************) -val handle: Jsonrpc.Request.t -> (Lsp_server.state as 's) -> 's * Jsonrpc.Response.t -val shutdown: Lsp_server.state -> unit +val handle: Jsonrpc.Request.t -> (Server.state as 's) -> 's * Jsonrpc.Response.t +val shutdown: Server.state -> unit module INTERNAL: sig val lookup_definition - : Lsp_server.t + : Server.t -> Lsp.Types.DefinitionParams.t -> [> `Location of Lsp.Types.Location.t list ] option val lookup_definition_in_doc : Lsp.Types.DefinitionParams.t - -> Lsp_document.checked_doc + -> Document.checked_doc -> [> `Location of Lsp.Types.Location.t list ] option val lookup_references - : Lsp_server.t + : Server.t -> Lsp.Types.ReferenceParams.t -> Lsp.Types.Location.t list option val lookup_references_in_doc : Lsp.Types.ReferenceParams.t - -> Lsp_document.checked_doc + -> Document.checked_doc -> Lsp.Types.Location.t list option val hover - : Lsp_server.t + : Server.t -> Lsp.Types.HoverParams.t -> Lsp.Types.Hover.t option val formatting - : Lsp_server.t + : Server.t -> Lsp.Types.DocumentFormattingParams.t -> Lsp.Types.TextEdit.t list option end diff --git a/src/lsp/cobol_lsp/lsp_server.ml b/src/lsp/cobol_lsp/server.ml similarity index 83% rename from src/lsp/cobol_lsp/lsp_server.ml rename to src/lsp/cobol_lsp/server.ml index 5b2c01372..e3e85af2b 100644 --- a/src/lsp/cobol_lsp/lsp_server.ml +++ b/src/lsp/cobol_lsp/server.ml @@ -19,14 +19,14 @@ module DIAGS = Cobol_common.Diagnostics module TYPES = struct type config = { - project_layout: Lsp_project.layout; - cache_config: Lsp_project_cache.config; + project_layout: Project.layout; + cache_config: Project_cache.config; } type registry = { (* private *) - projects: Lsp_project.SET.t; - docs: Lsp_document.t URIMap.t; - indirect_diags: Lsp_diagnostics.t URIMap.t; (* diagnostics for other URIs + projects: Project.SET.t; + docs: Document.t URIMap.t; + indirect_diags: Diagnostics.t URIMap.t; (* diagnostics for other URIs mentioned by docs in `docs` *) config: config; @@ -56,18 +56,18 @@ type t = registry (* Code: *) let add_project proj r = - let projects = Lsp_project.SET.add proj r.projects in + let projects = Project.SET.add proj r.projects in if projects == r.projects then r else { r with projects } let add_or_replace_doc doc r = - let docs = URIMap.add (Lsp_document.uri doc) doc r.docs in + let docs = URIMap.add (Document.uri doc) doc r.docs in if docs == r.docs then r else { r with docs } (** {2 Handling of diagnostics for non-opened documents} *) -let dispatch_diagnostics (Lsp_document.{ project; diags; _ } as doc) registry = - let uri = Lsp_document.uri doc in - let rootdir = Lsp_project.rootdir project in +let dispatch_diagnostics (Document.{ project; diags; _ } as doc) registry = + let uri = Document.uri doc in + let rootdir = Project.rootdir project in let indirect4uri = if diags <> DIAGS.Set.none then URIMap.empty (* stick to the new diagnostics *) @@ -75,13 +75,13 @@ let dispatch_diagnostics (Lsp_document.{ project; diags; _ } as doc) registry = in if URIMap.is_empty indirect4uri then begin let all_diags = - Lsp_diagnostics.translate diags ~uri:(`Main uri) - ~rootdir:(Lsp_project.string_of_rootdir rootdir) + Diagnostics.translate diags ~uri:(`Main uri) + ~rootdir:(Project.string_of_rootdir rootdir) in (* Note here we may publish diagnostics for non-opened documents. LSP protocol does not seem to forbid that (but some editors just ignore those). *) - Lsp_diagnostics.publish all_diags; + Diagnostics.publish all_diags; { registry with indirect_diags = (* Register published diagnostics for the other documents in case they @@ -94,14 +94,14 @@ let dispatch_diagnostics (Lsp_document.{ project; diags; _ } as doc) registry = URIMap.union (fun _ a b -> Some (List.rev_append a b)) end indirect4uri URIMap.empty in - Lsp_diagnostics.publish all_diags; + Diagnostics.publish all_diags; registry end (** {2 Management of per-project caches} *) let save_project_caches { config = { cache_config = config; _ }; docs; _ } = - try Lsp_project_cache.save ~config docs + try Project_cache.save ~config docs with e -> Lsp_error.internal "Exception@ caught@ while@ saving@ project@ caches:@ %a@." Fmt.exn e @@ -109,9 +109,9 @@ let save_project_caches { config = { cache_config = config; _ }; docs; _ } = let load_project_cache ~rootdir ({ config = { project_layout = layout; cache_config = config; _ }; projects; docs = old_docs; _ } as registry) = - let new_docs = Lsp_project_cache.load ~config ~layout ~rootdir in + let new_docs = Project_cache.load ~config ~layout ~rootdir in let projects = match URIMap.choose_opt new_docs with - | Some (_, Lsp_document.{ project = p; _ }) -> Lsp_project.SET.add p projects + | Some (_, Document.{ project = p; _ }) -> Project.SET.add p projects | None -> projects and docs = URIMap.union (fun _ _old new_ -> Some new_) old_docs new_docs in { registry with projects; docs } @@ -122,17 +122,17 @@ let load_project_cache ~rootdir ({ config = { project_layout = layout; let init ~config : registry = { config; - projects = Lsp_project.SET.empty; + projects = Project.SET.empty; docs = URIMap.empty; indirect_diags = URIMap.empty; } let create_or_retrieve_project ~uri registry = let layout = registry.config.project_layout in - let rootdir = Lsp_project.rootdir_for ~uri ~layout in - try Lsp_project.SET.for_rootdir ~rootdir registry.projects, registry + let rootdir = Project.rootdir_for ~uri ~layout in + try Project.SET.for_rootdir ~rootdir registry.projects, registry with Not_found -> - let project = Lsp_project.for_ ~rootdir ~layout in + let project = Project.for_ ~rootdir ~layout in project, add_project project registry let document_error_while_ operation doc e backtrace registry = @@ -146,10 +146,10 @@ let add (DidOpenTextDocumentParams.{ textDocument = { uri; _ }; _ } as doc) ?copybook registry = let project, registry = create_or_retrieve_project ~uri registry in try - let doc = Lsp_document.load ~project ?copybook doc in + let doc = Document.load ~project ?copybook doc in let registry = dispatch_diagnostics doc registry in add_or_replace_doc doc registry - with Lsp_document.Internal_error (doc, e, backtrace) -> + with Document.Internal_error (doc, e, backtrace) -> document_error_while_"opening" doc e backtrace registry let did_open (DidOpenTextDocumentParams.{ textDocument = { uri; text; _ }; @@ -165,8 +165,8 @@ let did_open (DidOpenTextDocumentParams.{ textDocument = { uri; text; _ }; | None | Some _ when try_cache -> let registry = let layout = registry.config.project_layout in - let rootdir = Lsp_project.rootdir_for ~uri ~layout in - if Lsp_project.SET.mem_rootdir ~rootdir registry.projects + let rootdir = Project.rootdir_for ~uri ~layout in + if Project.SET.mem_rootdir ~rootdir registry.projects then registry else load_project_cache ~rootdir registry in @@ -185,10 +185,10 @@ let did_change DidChangeTextDocumentParams.{ textDocument = { uri; _ }; contentChanges; _ } registry = try let doc = find_document TextDocumentIdentifier.{ uri } registry in - let doc = Lsp_document.update doc contentChanges in + let doc = Document.update doc contentChanges in let registry = dispatch_diagnostics doc registry in add_or_replace_doc doc registry - with Lsp_document.Internal_error (doc, e, backtrace) -> + with Document.Internal_error (doc, e, backtrace) -> document_error_while_"updating" doc e backtrace registry let did_close DidCloseTextDocumentParams.{ textDocument = { uri } } registry = diff --git a/src/lsp/cobol_lsp/lsp_server.mli b/src/lsp/cobol_lsp/server.mli similarity index 90% rename from src/lsp/cobol_lsp/lsp_server.mli rename to src/lsp/cobol_lsp/server.mli index e47e4b0a2..76d54111b 100644 --- a/src/lsp/cobol_lsp/lsp_server.mli +++ b/src/lsp/cobol_lsp/server.mli @@ -16,14 +16,14 @@ open Lsp_imports module TYPES: sig type config = { - project_layout: Lsp_project.layout; - cache_config: Lsp_project_cache.config; + project_layout: Project.layout; + cache_config: Project_cache.config; } type registry = private { - projects: Lsp_project.SET.t; - docs: Lsp_document.t URIMap.t; - indirect_diags: Lsp_diagnostics.t URIMap.t; (* diagnostics for other URIs + projects: Project.SET.t; + docs: Document.t URIMap.t; + indirect_diags: Diagnostics.t URIMap.t; (* diagnostics for other URIs mentioned by docs in `docs` *) config: config; @@ -73,7 +73,7 @@ val did_close : Lsp.Types.DidCloseTextDocumentParams.t -> t -> t val find_document - : Lsp.Types.TextDocumentIdentifier.t -> t -> Lsp_document.t + : Lsp.Types.TextDocumentIdentifier.t -> t -> Document.t val jsonrpc_of_error : 'a error -> string -> Jsonrpc.Response.Error.t diff --git a/src/lsp/cobol_lsp/lsp_utils.ml b/src/lsp/cobol_lsp/utils.ml similarity index 100% rename from src/lsp/cobol_lsp/lsp_utils.ml rename to src/lsp/cobol_lsp/utils.ml diff --git a/src/lsp/cobol_lsp/lsp_utils.mli b/src/lsp/cobol_lsp/utils.mli similarity index 100% rename from src/lsp/cobol_lsp/lsp_utils.mli rename to src/lsp/cobol_lsp/utils.mli diff --git a/src/lsp/superbol_free_lib/command_lsp.ml b/src/lsp/superbol_free_lib/command_lsp.ml index 3db5126f6..81c27dcc1 100644 --- a/src/lsp/superbol_free_lib/command_lsp.ml +++ b/src/lsp/superbol_free_lib/command_lsp.ml @@ -16,9 +16,9 @@ open EZCMD.TYPES let run_lsp ~enable_caching ~storage = - Cobol_lsp.INTERNAL.Debug.message "LSP Started with pid %d\n%!" + Cobol_lsp.Lsp_debug.message "LSP Started with pid %d\n%!" (Unix.getpid ()); - Cobol_preproc.Src_overlay.debug_oc := !Cobol_lsp.INTERNAL.Debug.debug_oc; + Cobol_preproc.Src_overlay.debug_oc := !Cobol_lsp.Lsp_debug.debug_oc; let project_layout, fallback_storage_directory = match storage with @@ -28,10 +28,10 @@ let run_lsp ~enable_caching ~storage = Project.{ layout with relative_work_dirname = None }, Some dir in let lsp_config = - Cobol_lsp.config () + Cobol_lsp.Loop.config () ~enable_caching ~project_layout ?fallback_storage_directory in - match Cobol_lsp.run ~config:lsp_config with + match Cobol_lsp.Loop.run ~config:lsp_config with | Ok () -> () | Error exit_msg -> Pretty.error "%s@." exit_msg; exit 1 diff --git a/test/lsp/lsp_definition.ml b/test/lsp/lsp_definition.ml index 63b045fcb..bcfdeab6d 100644 --- a/test/lsp/lsp_definition.ml +++ b/test/lsp/lsp_definition.ml @@ -23,7 +23,7 @@ let print_definitions ~projdir server (doc, positions) : unit = let params = DefinitionParams.create ~position ~textDocument:prog () in Pretty.out "%s (line %d, character %d):@." position_name position.line position.character; - match LSP.Request.lookup_definition server params with + match Cobol_lsp.Request.INTERNAL.lookup_definition server params with | None | Some (`Location []) -> Pretty.out "No definition found@." | Some (`Location locs) -> @@ -31,7 +31,7 @@ let print_definitions ~projdir server (doc, positions) : unit = (* Yojson.Safe.to_channel Stdlib.stdout @@ *) (* Lsp.Client_request.yojson_of_result *) (* (Lsp.Client_request.TextDocumentDefinition params) *) - (* (LSP.Request.lookup_definition server params); *) + (* (Cobol_lsp.Request.lookup_definition server params); *) end positions.pos_map ;; diff --git a/test/lsp/lsp_formatting.ml b/test/lsp/lsp_formatting.ml index 16f6daf68..fc62b6994 100644 --- a/test/lsp/lsp_formatting.ml +++ b/test/lsp/lsp_formatting.ml @@ -27,8 +27,8 @@ let format_doc doc = let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in DocumentFormattingParams.create ~options ~textDocument:prog () in - let doc = (LSP.Types.URIMap.find prog.uri server.docs).textdoc in - let formatted = LSP.Request.formatting server params in + let doc = (Cobol_lsp.Alltypes.URIMap.find prog.uri server.docs).textdoc in + let formatted = Cobol_lsp.Request.INTERNAL.formatting server params in Option.map (fun edits -> Lsp.Text_document.apply_text_document_edits doc edits |> Lsp.Text_document.text ) formatted, end_with_postproc diff --git a/test/lsp/lsp_hover.ml b/test/lsp/lsp_hover.ml index a4b84621b..5bfe13d9c 100644 --- a/test/lsp/lsp_hover.ml +++ b/test/lsp/lsp_hover.ml @@ -22,7 +22,7 @@ let print_hovered server ~projdir (prog, prog_positions) = Pretty.out "%a(line %d, character %d):@." Fmt.(option ~none:nop @@ fmt "%s ") key position.line position.character; - match LSP.Request.hover server params with + match Cobol_lsp.Request.INTERNAL.hover server params with | None -> Pretty.out "Hovering nothing worthy@." | Some { contents = `List strings; range } -> diff --git a/test/lsp/lsp_references.ml b/test/lsp/lsp_references.ml index e04c59a1f..fad40244a 100644 --- a/test/lsp/lsp_references.ml +++ b/test/lsp/lsp_references.ml @@ -27,7 +27,7 @@ let print_references ~projdir server (doc, positions) : unit = in Pretty.out "%s (line %d, character %d):@." position_name position.line position.character; - match LSP.Request.lookup_references server params with + match Cobol_lsp.Request.INTERNAL.lookup_references server params with | None | Some [] -> Pretty.out "No reference found@." | Some locs -> diff --git a/test/lsp/lsp_testing.ml b/test/lsp/lsp_testing.ml index 940dd873f..fddeaca02 100644 --- a/test/lsp/lsp_testing.ml +++ b/test/lsp/lsp_testing.ml @@ -23,7 +23,6 @@ open Ez_file.V1 open Ez_file.FileString.OP module StrMap = EzCompat.StringMap -module LSP = Cobol_lsp.INTERNAL (* Used to remove full-path and lines in the test files *) let () = @@ -34,7 +33,7 @@ let () = let layout = Superbol_free_lib.Project.layout; and cache_config = - LSP.Project_cache.{ + Cobol_lsp.Project_cache.{ cache_storage = No_storage; cache_verbose = false; } @@ -46,14 +45,14 @@ let init_temp_project ?(toml = "") () = projdir let make_server () = - LSP.Server.init ~config:{ project_layout = layout; cache_config } + Cobol_lsp.Server.init ~config:{ project_layout = layout; cache_config } let add_cobol_doc server ?copybook ~projdir filename text = let path = projdir // filename in let uri = Lsp.Uri.of_path path in EzFile.write_file path text; let server = - LSP.Server.did_open ?copybook + Cobol_lsp.Server.did_open ?copybook DidOpenTextDocumentParams.{ textDocument = TextDocumentItem.{ languageId = "cobol"; version = 0; text; uri; @@ -106,7 +105,7 @@ let make_lsp_project ?toml () = print_endline in (* Force project initialization (so we can flush before the next RPC) *) - ignore @@ LSP.Project.in_existing_dir projdir ~layout; + ignore @@ Cobol_lsp.Project.in_existing_dir projdir ~layout; print_newline (); { projdir; end_with_postproc }, make_server () @@ -228,7 +227,7 @@ end (* --- *) (* let%expect_test "initialize-server" = *) -(* ignore @@ LSP.Project.in_existing_dir projdir ~layout; *) +(* ignore @@ Cobol_lsp.Project.in_existing_dir projdir ~layout; *) (* print_postproc [%expect.output]; *) (* [%expect {| *) (* {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} *) diff --git a/test/lsp/lsp_testing.mli b/test/lsp/lsp_testing.mli index a6f338f2c..f161e825b 100644 --- a/test/lsp/lsp_testing.mli +++ b/test/lsp/lsp_testing.mli @@ -12,7 +12,6 @@ (**************************************************************************) module StrMap = EzCompat.StringMap -module LSP = Cobol_lsp.INTERNAL type test_project = { @@ -23,10 +22,10 @@ type test_project = val make_lsp_project : ?toml:string -> unit - -> test_project * LSP.Types.registry + -> test_project * Cobol_lsp.Alltypes.registry val add_cobol_doc - : LSP.Types.registry -> ?copybook:bool -> projdir:string -> string -> string - -> LSP.Types.registry * Lsp.Types.TextDocumentIdentifier.t + : Cobol_lsp.Alltypes.registry -> ?copybook:bool -> projdir:string -> string -> string + -> Cobol_lsp.Alltypes.registry * Lsp.Types.TextDocumentIdentifier.t type positions = {