diff --git a/sphinx/commands.rst b/sphinx/commands.rst index 6b06827c1..0da292b2e 100644 --- a/sphinx/commands.rst +++ b/sphinx/commands.rst @@ -168,8 +168,6 @@ Where options are: * :code:`--free` Shorthand for `--source-format FREE` -* :code:`--indent_config FILE` User defined configuration of indentation - * :code:`--recovery BOOL` Enable/disable parser recovery after syntax errors (default: true) * :code:`--silence STRING` Silence specific messages @@ -212,8 +210,6 @@ Where options are: * :code:`--free` Shorthand for `--source-format FREE` -* :code:`--indent_config FILE` User defined offset table file - * :code:`--recovery BOOL` Enable/disable parser recovery after syntax errors (default: true) * :code:`--silence STRING` Silence specific messages @@ -277,6 +273,12 @@ Start a COBOL LSP server Where options are: +* :code:`--caching` Enable caching (enabled by default) + +* :code:`--force-storage DIR` Directory under which to store cache data --- prevents the creation of a "_superbol" storage directory at the root of project trees. + +* :code:`--no-caching` Disable caching (enabled by default) + main.exe pp ~~~~~~~~~~~~~ diff --git a/src/lsp/cobol_lsp/lsp_project.mli b/src/lsp/cobol_lsp/lsp_project.mli index 4b647a23b..ad58f5d79 100644 --- a/src/lsp/cobol_lsp/lsp_project.mli +++ b/src/lsp/cobol_lsp/lsp_project.mli @@ -44,8 +44,8 @@ val in_existing_dir: string -> layout:layout -> t (** [rootdir_for ~uri ~layout] locates the project directory (that contains a file with given name [layout.project_config_filename]) for a file at the - given URI. Returns the name of the directory that contains the file at URI - if no project file is found. *) + given URI. The behavior when no such file is found is that of + {!Superbol_project.rootdir_for}. *) val rootdir_for: uri:Lsp.Uri.t -> layout:layout -> rootdir (** [libpath_for ~uri project] constructs a list of directory names where diff --git a/src/lsp/cobol_lsp/lsp_project_cache.ml b/src/lsp/cobol_lsp/lsp_project_cache.ml index e102ec0e7..8dd71d6bd 100644 --- a/src/lsp/cobol_lsp/lsp_project_cache.ml +++ b/src/lsp/cobol_lsp/lsp_project_cache.ml @@ -18,11 +18,18 @@ open Ez_file.V1.EzFile.OP module DIAGS = Cobol_common.Diagnostics module TYPES = struct + + type storage = + | No_storage + | Store_in_file of { relative_filename: string } + | Store_in_shared_dir of { dirname: string } + type config = { - cache_relative_filename: string; + cache_storage: storage; cache_verbose: bool; } + end include TYPES @@ -45,7 +52,14 @@ type cached_project_record = (* Code: *) let cache_filename ~config ~rootdir = - Lsp_project.string_of_rootdir rootdir // config.cache_relative_filename + match config.cache_storage with + | No_storage -> + None + | Store_in_file { relative_filename } -> + Some (Lsp_project.string_of_rootdir rootdir // relative_filename) + | Store_in_shared_dir { dirname } -> + Some (dirname // Digest.(to_hex @@ + string @@ Lsp_project.string_of_rootdir rootdir)) let version_tag_length = 40 (* use full commit hash when available *) let version_tag = @@ -77,14 +91,17 @@ let save_project_cache ~config cached_docs; } in - let cache_file = cache_filename ~config ~rootdir in - EzFile.(make_dir ~p:true (dirname cache_file)); - (* NB: don't really care if we rewrite the same cache again *) - (* 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); - Lsp_io.pretty_notification "Wrote cache at: %s" cache_file ~type_:Info + match cache_filename ~config ~rootdir with + | Some cache_file -> + EzFile.(make_dir ~p:true (dirname cache_file)); + (* NB: don't really care if we rewrite the same cache again *) + (* 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); + Lsp_io.pretty_notification "Wrote cache at: %s" cache_file ~type_:Info + | None -> + () let save ~config docs = (* Pivot all active projects: associate projects with all their documents, and @@ -122,20 +139,24 @@ let load_project ~rootdir ~layout ~config { cached_project; cached_docs; _ } = let load ~rootdir ~layout ~config = let fallback = URIMap.empty in - let cache_file = cache_filename ~config ~rootdir in - try + let load_cache cache_file = let cached_project = Lsp_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 - with - | Failure msg | Sys_error msg -> - if config.cache_verbose then - Lsp_io.pretty_notification "Failed to read cache: %s" - msg ~log:true ~type_:Info; - fallback - | e -> - Lsp_io.pretty_notification "Failed to read cache: %a" - Fmt.exn e ~log:true ~type_:Warning; + in + match cache_filename ~config ~rootdir with + | None -> fallback + | Some cache_file -> + try load_cache cache_file with + | Failure msg | Sys_error msg -> + if config.cache_verbose then + Lsp_io.pretty_notification "Failed to read cache: %s" + msg ~log:true ~type_:Info; + fallback + | e -> + Lsp_io.pretty_notification "Failed to read cache: %a" + Fmt.exn e ~log:true ~type_:Warning; + fallback diff --git a/src/lsp/cobol_lsp/lsp_project_cache.mli b/src/lsp/cobol_lsp/lsp_project_cache.mli index 666d58b19..b080ef83d 100644 --- a/src/lsp/cobol_lsp/lsp_project_cache.mli +++ b/src/lsp/cobol_lsp/lsp_project_cache.mli @@ -14,15 +14,27 @@ open Lsp_imports module TYPES: sig + type storage = + | No_storage + | Store_in_file of + { + (** Name of cache file, relative to project root directory. *) + relative_filename: string; + } + | Store_in_shared_dir of + { + dirname: string; + } + type config = { - (** Name of cache file, relative to project root directory. *) - cache_relative_filename: string; + cache_storage: storage; cache_verbose: bool; } end include module type of TYPES - with type config = TYPES.config + with type storage = TYPES.storage + and type config = TYPES.config (** [save ~config docs] saves the caches of all the given document's projects. diff --git a/src/lsp/cobol_lsp/lsp_server_loop.ml b/src/lsp/cobol_lsp/lsp_server_loop.ml index 709aaa503..9cbfc937b 100644 --- a/src/lsp/cobol_lsp/lsp_server_loop.ml +++ b/src/lsp/cobol_lsp/lsp_server_loop.ml @@ -16,27 +16,50 @@ open Ez_file.V1 open Ez_file.V1.EzFile.OP -(** [config ~project_config_filename ~relative_work_dirname] creates an LSP - configuration structure for identifying and managing projects. +(** [config ~project_layout ~enable_caching ~fallback_storage_directory ()] + creates an LSP configuration structure for identifying and managing + projects. - - [project_config_filename] is the names of the TOML file that is to be - found at the root of each project's directory tree; + - [project_layout] describes the layout of projects to be managed by the + LSP; - - [relative_work_dirname] is the name of the directory where the LSP should - put its working files (caches, etc). *) -let config ~(project_layout: Lsp_project.layout) = - let relative_work_dirname = project_layout.relative_work_dirname in - let invalid_dir reason = - Fmt.invalid_arg - ("relative_work_dirname: "^^reason^^" (got `%s')") relative_work_dirname + - [enable_caching] (defaulting to [true]) permits the storage of + pre-computed data, to allow faster LSP restarts and re-opening documents; + + - [fallback_storage_directory], when provided (and if [enable_caching] + holds), is the name of a directory that is used to store a cache whenever + [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) + ?(enable_caching = true) + ?(fallback_storage_directory: string option) + () = + let cache_storage: Lsp_project_cache.storage = + match project_layout.relative_work_dirname, fallback_storage_directory with + | _ when not enable_caching -> + No_storage + | None, None -> + No_storage + | None, Some dirname -> + Store_in_shared_dir { dirname } + | Some relative_work_dirname, _ -> + let invalid_dir reason = + Fmt.invalid_arg + ("relative_work_dirname: "^^reason^^" (got `%s')") + relative_work_dirname + in + if relative_work_dirname = "" + then invalid_dir "invalid directory name"; + if EzFile.is_absolute relative_work_dirname + then invalid_dir "relative directory name expected"; + Store_in_file { + relative_filename = relative_work_dirname // "lsp-cache"; + } in - if relative_work_dirname = "" - then invalid_dir "invalid direcory name"; - if EzFile.is_absolute relative_work_dirname - then invalid_dir "relative direcory name expected"; Lsp_server.{ cache_config = { - cache_relative_filename = relative_work_dirname // "lsp-cache"; + cache_storage; cache_verbose = true; }; project_layout; diff --git a/src/lsp/cobol_lsp/lsp_server_loop.mli b/src/lsp/cobol_lsp/lsp_server_loop.mli index d0e6e2a6b..7bbfeb5d7 100644 --- a/src/lsp/cobol_lsp/lsp_server_loop.mli +++ b/src/lsp/cobol_lsp/lsp_server_loop.mli @@ -13,6 +13,9 @@ val config : project_layout: Superbol_project.layout + -> ?enable_caching: bool + -> ?fallback_storage_directory: string + -> unit -> Lsp_server.config val run diff --git a/src/lsp/superbol_free_lib/arg_utils.ml b/src/lsp/superbol_free_lib/arg_utils.ml new file mode 100644 index 000000000..5e0f767d5 --- /dev/null +++ b/src/lsp/superbol_free_lib/arg_utils.ml @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ezcmd.V2 +open EZCMD.TYPES + +let en'dis'able_switch ~name ~default = + let switch = ref default in + let default = if default then "enabled" else "disabled" in + switch, + [ + [name], Arg.Set switch, + Pretty.string_to EZCMD.info "Enable %s (%s by default)" name default; + + ["no-"^name], Arg.Clear switch, + Pretty.string_to EZCMD.info "Disable %s (%s by default)" name default; + ] diff --git a/src/lsp/superbol_free_lib/arg_utils.mli b/src/lsp/superbol_free_lib/arg_utils.mli new file mode 100644 index 000000000..2c0d971ed --- /dev/null +++ b/src/lsp/superbol_free_lib/arg_utils.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val en'dis'able_switch + : name: string + -> default: bool + -> bool ref * Ezcmd.V2.EZCMD.TYPES.arg_list diff --git a/src/lsp/superbol_free_lib/command_lsp.ml b/src/lsp/superbol_free_lib/command_lsp.ml index 8623ae1b3..f3f5431ca 100644 --- a/src/lsp/superbol_free_lib/command_lsp.ml +++ b/src/lsp/superbol_free_lib/command_lsp.ml @@ -12,19 +12,41 @@ (**************************************************************************) open Ezcmd.V2 +open EZCMD.TYPES -let lsp_config = - Cobol_lsp.config ~project_layout:Project.layout -let run_lsp () = +let run_lsp ~enable_caching ~force_storage = + let project_layout, fallback_storage_directory = + match force_storage with + | None -> + Project.layout, None + | Some dir -> + Project.{ layout with relative_work_dirname = None }, Some dir + in + let lsp_config = + Cobol_lsp.config () + ~enable_caching ~project_layout ?fallback_storage_directory + in match Cobol_lsp.run ~config:lsp_config with | Ok () -> () | Error exit_msg -> Pretty.error "%s@." exit_msg; exit 1 + let cmd = + let caching, caching_args = + Arg_utils.en'dis'able_switch ~name:"caching" ~default:true + in + let storage = ref None in EZCMD.sub "lsp" - run_lsp + (fun () -> + run_lsp ~enable_caching:!caching ~force_storage:!storage) ~doc:"run LSP server" + ~args: (caching_args @ [ + ["force-storage"], Arg.String (fun s -> storage := Some s), + EZCMD.info ~docv:"DIR" + "Directory under which to store cache data --- prevents the creation \ + of a \"_superbol\" storage directory at the root of project trees."; + ]) ~man:[ `S "DESCRIPTION"; `Blocks [ diff --git a/src/lsp/superbol_free_lib/project.ml b/src/lsp/superbol_free_lib/project.ml index 0479956dc..b3cbafb06 100644 --- a/src/lsp/superbol_free_lib/project.ml +++ b/src/lsp/superbol_free_lib/project.ml @@ -18,7 +18,8 @@ module DIAGS = Cobol_common.Diagnostics let layout = Superbol_project.{ project_config_filename = "superbol.toml"; - relative_work_dirname = "_superbol"; + relative_work_dirname = Some "_superbol"; + rootdir_fallback_policy = Same_as_file_directory; } let load_in_ ~dirname = diff --git a/src/lsp/superbol_project/project.ml b/src/lsp/superbol_project/project.ml index b3e14b438..a3c0eab03 100644 --- a/src/lsp/superbol_project/project.ml +++ b/src/lsp/superbol_project/project.ml @@ -28,9 +28,14 @@ module TYPES = struct type layout = { project_config_filename: string; - relative_work_dirname: string; + relative_work_dirname: string option; + rootdir_fallback_policy: rootdir_fallback_policy; } + and rootdir_fallback_policy = + | Same_as_file_directory + | Given_directory of string + end include TYPES type t = project @@ -52,22 +57,22 @@ let rootdir_at ~dirname : rootdir = then dirname else Fmt.invalid_arg "Expected existing directory: %s" dirname -let rootdir_for ~filename ~layout:{ project_config_filename; _ } = +let rootdir_for ~filename + ~layout:{ project_config_filename; rootdir_fallback_policy; _ } = let rec try_dir dir = if EzFile.exists (dir // project_config_filename) - then Some dir + then dir else let new_dir = EzFile.dirname dir in if new_dir = dir - then None (* we are at root *) + then raise Not_found (* we are at root *) else try_dir new_dir in - let dir = match try_dir (EzFile.dirname filename) with - | Some dir -> dir - | None -> EzFile.dirname filename - in - (* Pretty.error "Project directory: %s@." dir; *) - dir + let dirname = EzFile.dirname filename in + try try_dir dirname + with Not_found -> match rootdir_fallback_policy with + | Same_as_file_directory -> dirname + | Given_directory dirname -> dirname let with_default_config ~rootdir ~layout:{ project_config_filename; _ } = { diff --git a/src/lsp/superbol_project/project.mli b/src/lsp/superbol_project/project.mli index 49321d0da..a073ee001 100644 --- a/src/lsp/superbol_project/project.mli +++ b/src/lsp/superbol_project/project.mli @@ -27,13 +27,27 @@ module TYPES: sig type layout = { project_config_filename: string; - relative_work_dirname: string; + (** Name of the TOML file that is to be found at the root of each project's + directory tree. *) + + relative_work_dirname: string option; + (** Relative name of a directory where the LSP should put its working files + (caches, etc). No such storage is allowed when [None]. *) + + rootdir_fallback_policy: rootdir_fallback_policy; + (** Policy to determine the root directory of projects based on individual + filenames. *) } + and rootdir_fallback_policy = + | Same_as_file_directory + | Given_directory of string + end include module type of TYPES with type rootdir = TYPES.rootdir and type project = TYPES.project + and type rootdir_fallback_policy = TYPES.rootdir_fallback_policy and type layout = TYPES.layout type t = project @@ -49,8 +63,13 @@ val rootdir_at: dirname:string -> rootdir (** [rootdir_for ~filename ~layout] locates the project directory for a given file name. This project directory is the closest parent directory of [filename] that contains a file with the name - [layout.project_config_filename]. Returns the name of the directory that - contains [filename] if no such file is found. *) + [layout.project_config_filename]. + + When no such file is found, the behavior depend on the given fallback + policy: if [layout.rootdir_fallback_policy = Same_as_file_directory], the + name of the directory that contains [filename] is chosen of root for the + project; alternatively, if the fallback is [Given_directory dirname], the + latter directory is used instead. *) val rootdir_for: filename:string -> layout:layout -> rootdir (** [for_ ~rootdir ~layout] retrieves a project based on its root directory. diff --git a/test/lsp/lsp_testing.ml b/test/lsp/lsp_testing.ml index b4f984cb6..940dd873f 100644 --- a/test/lsp/lsp_testing.ml +++ b/test/lsp/lsp_testing.ml @@ -35,7 +35,7 @@ let layout = Superbol_free_lib.Project.layout; and cache_config = LSP.Project_cache.{ - cache_relative_filename = "lsp-cache"; + cache_storage = No_storage; cache_verbose = false; }