New LSP argument --force-storage=DIR

When provided, `--force-storage=DIR` forces cache files to reside
inside the given directory name; this prevents the creation of
`_superbol` directories at the root of project trees.

Side changes include enhancements to the description of project
layouts, and command-line flags to enable or disable caching.

These are preliminary steps to address #107

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
 ~~~~~~~~~~~~~

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

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

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.

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;

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

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;
+  ]

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

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 [

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 =

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; _ } =
   {