Add a basic caching infrastructure in Superbol_platform

src/lsp/cobol_common/platform.ml

@@ -47,6 +47,8 @@ module TYPES = struct
     mutable error :  'a. ('a, Format.formatter, unit) format -> 'a ;
     mutable read_file : string -> string ;
     mutable getenv_opt : string -> string option ;
+    mutable mk_temp_dir: ?mode:int -> ?dir:string -> string -> string;
+    mutable remove_dir: ?all:bool -> string -> unit;
 
     mutable autodetect_format:
       ?source_contents:string ->
@@ -74,6 +76,14 @@ let innocuous = {
     Pretty.string_to (fun msg -> raise (Sys_error msg))
       "%s: Filesystem operations are unavailable" file
   end;
+  mk_temp_dir = begin fun ?mode:_ ?dir:_ dirname ->
+    Pretty.string_to (fun msg -> raise (Sys_error msg))
+      "%s: Filesystem operations are unavailable" dirname
+  end;
+  remove_dir = begin fun ?all:_ dir ->
+    Pretty.string_to (fun msg -> raise (Sys_error msg))
+      "%s: Filesystem operations are unavailable" dir
+  end;
   autodetect_format = (fun ?source_contents:_ _filename -> SFFixed);
   find_lib = begin fun ~lookup_config ?fromfile:_ ?libname:_ (`Alphanum w |
                                                               `Word w) ->
@@ -82,12 +92,48 @@ let innocuous = {
   getenv_opt = (fun _variable -> None);
 }
 
-let copy ~dst ~src:{ verbosity; eprintf; error; read_file; autodetect_format;
-                     find_lib; getenv_opt }  =
+let copy ~dst ~src:{ verbosity; eprintf; error; read_file;
+                     mk_temp_dir; remove_dir;
+                     autodetect_format; find_lib; getenv_opt }  =
   dst.verbosity <- verbosity;
   dst.eprintf <- eprintf;
   dst.error <- error;
   dst.read_file <- read_file;
+  dst.mk_temp_dir <- mk_temp_dir;
+  dst.remove_dir <- remove_dir;
   dst.autodetect_format <- autodetect_format;
   dst.find_lib <- find_lib;
   dst.getenv_opt <- getenv_opt
+
+(* --- *)
+
+(** High-level filesystem operations *)
+module FS = struct
+
+  (** [with_temp_dir ~platform ?given_temp_dir f] creates a temporary directory
+      [temp_dir] and executes [f ~temp_dir] if [given_temp_dir] is [None], or
+      executes [f ~temp_dir:dir] if [given_temp_dir] is [Some dir].  [temp_dir] is
+      removed upon termination of [f] in the former case; otherwise, the directory
+      is left in place.
+
+      [default_pattern_prefix] is used to forge a name for the directory created,
+      if any. *)
+  let with_temp_dir ~platform ~default_pattern_prefix ?given_temp_dir f =
+    let temp_dir =
+      match given_temp_dir with
+      | None ->
+          platform.mk_temp_dir default_pattern_prefix
+      | Some dirname ->
+          dirname
+    in
+    let finalize () =
+      if given_temp_dir = None then
+        platform.remove_dir ~all:true temp_dir
+    in
+    match f ~temp_dir with
+    | res ->
+        finalize (); res
+    | exception e ->
+        finalize (); raise e
+
+end

src/lsp/superbol_platform/caching.ml

@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                        SuperBOL OSS Studio                             *)
+(*                                                                        *)
+(*  Copyright (c) 2022-2026 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 Ez_file.V1
+
+let with_in_bin file_name ~f =
+  let ic = EzFile.open_in_bin file_name in
+  match f ic with
+  | v -> close_in ic; v
+  | exception exn -> close_in ic; raise exn
+
+(* --- *)
+
+let version_tag_length = 40            (* use full commit hash when available *)
+
+(** Internal version tag *)
+let version_tag =
+  let str = Option.value Version.commit_hash ~default:Version.version in
+  if String.length str >= version_tag_length
+  then String.sub str 0 version_tag_length
+  else str ^ String.make (version_tag_length - String.length str) '_'
+
+let write_cache_item ?(version_tag = version_tag) oc item =
+  output_string oc version_tag;
+  Marshal.to_channel oc item []
+
+let read_cache_item ?(version_tag = version_tag) ic =
+  let version_tag' = really_input_string ic version_tag_length in
+  if version_tag' <> version_tag
+  then Fmt.failwith "Bad version tag: got %s, expected %s\
+                    " version_tag' version_tag;
+  Marshal.from_channel ic
+
+let cache_file_for ~item_name ~cache_dir =
+  EzFile.concat cache_dir item_name
+
+let save_named_item_cache ~cache_dir ~item_name ~write_item item =
+  let cache_file = cache_file_for ~item_name ~cache_dir in
+  EzFile.make_dir ~p:true @@ EzFile.dirname cache_file;
+  EzFile.with_out_bin cache_file (write_item item)
+
+let load_named_item_cache ~cache_dir ~item_name ~read_item =
+  with_in_bin (cache_file_for ~item_name ~cache_dir) ~f:read_item

src/lsp/superbol_platform/caching.mli

@@ -0,0 +1,48 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                        SuperBOL OSS Studio                             *)
+(*                                                                        *)
+(*  Copyright (c) 2022-2026 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.                                                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Helpers to construct persistent cache storage where each named individual
+    item is stored as a single file.
+
+    I/O operations are not performed via a generic platform.  Instead, they are
+    based on {!Ez_file.V1} (indirectly {!Unix}). *)
+
+(** [write_cache_item ?version_tag oc item] dumps a version tag, followed by
+    [item], on the stream [oc].  Relies on {!Marshal}. *)
+val write_cache_item: ?version_tag:string -> out_channel -> 'a -> unit
+
+(** [read_cache_item ?version_tag ic] reads and checks a version tag from [oc],
+    and then reads an [item] from the same stream.  Relies on {!Marshal}. *)
+val read_cache_item: ?version_tag:string -> in_channel -> 'a
+
+(** [save_named_item_cache ~cache_dir ~item_name ~write_item item] saves an
+    [item] with a unique name [item_name] in a cache file within [cache_dir].
+    [write_item] is used to dump the item: it should typically be a call to
+    {!write_cache_item}. *)
+val save_named_item_cache
+  : cache_dir:string
+  -> item_name:string
+  -> write_item:('a -> out_channel -> unit)
+  -> 'a
+  -> unit
+
+(** [load_named_item_cache ~cache_dir ~item_name ~read_item] loads an item named
+    [item_name] from a cache file in [cache_dir].  [read_item] is used to read
+    the item: it should typically be a call to {!read_cache_item}.
+
+    Raises {!Sys_error} in case no item with name [item_name] is found in cache
+    directory [cache_dir]. *)
+val load_named_item_cache
+  : cache_dir:string
+  -> item_name:string
+  -> read_item:(in_channel -> 'a) -> 'a

src/lsp/superbol_platform/superbol_platform.ml

@@ -2,7 +2,7 @@
 (*                                                                        *)
 (*                        SuperBOL OSS Studio                             *)
 (*                                                                        *)
-(*  Copyright (c) 2022-2023 OCamlPro SAS                                  *)
+(*  Copyright (c) 2022-2026 OCamlPro SAS                                  *)
 (*                                                                        *)
 (* All rights reserved.                                                   *)
 (* This source code is licensed under the GNU Affero General Public       *)
@@ -19,7 +19,12 @@ let record =
     eprintf = Printf.eprintf;
     error = Pretty.error;
     read_file = (fun file -> Ez_file.V1.EzFile.read_file file);
+    mk_temp_dir = Tempdir.create;
+    remove_dir = (fun ?all dir -> Ez_file.V1.EzFile.remove_dir ?all dir);
     autodetect_format = Heuristics.autodetect_format;
     find_lib = Copybook_finder.find_lib;
     getenv_opt = (fun variable -> Sys.getenv_opt variable);
   }
+
+module Tempdir = Tempdir
+module Caching = Caching

src/lsp/superbol_platform/tempdir.ml

@@ -0,0 +1,36 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                        SuperBOL OSS Studio                             *)
+(*                                                                        *)
+(*  Copyright (c) 2022-2026 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.                                                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* https://discuss.ocaml.org/t/how-to-create-a-temporary-directory-in-ocaml/1815/4 *)
+let rand_digits () =
+  Printf.sprintf "%06x" Random.State.(bits (make_self_init ()) land 0xFFFFFF)
+
+let create ?(mode=0o700) ?dir pat =
+  let dir = match dir with
+    | Some d -> d
+    | None   -> Filename.get_temp_dir_name ()
+  in
+  let raise_err msg = raise (Sys_error msg) in
+  let rec loop count =
+    if count < 0
+    then
+      raise_err "mk_temp_dir: too many failing attemps"
+    else
+      let dir = Printf.sprintf "%s/%s%s" dir pat (rand_digits ()) in
+      try (Unix.mkdir dir mode; dir) with
+      | Unix.Unix_error (Unix.EEXIST, _, _) -> loop (count - 1)
+      | Unix.Unix_error (Unix.EINTR, _, _)  -> loop count
+      | Unix.Unix_error (e, _, _)           ->
+          raise_err ("mk_temp_dir: " ^ (Unix.error_message e))
+  in
+  loop 1000

src/lsp/superbol_platform/tempdir.mli

@@ -0,0 +1,14 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                        SuperBOL OSS Studio                             *)
+(*                                                                        *)
+(*  Copyright (c) 2022-2026 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 create: ?mode:int -> ?dir:string -> string -> string

test/testdeps/dune

@@ -1,6 +1,6 @@
 (library
   (name superbol_testutils)
   (wrapped true)
-  (libraries autofonce_lib)
+  (libraries autofonce_lib superbol_platform)
   (flags (:standard)))
 

test/testdeps/tempdir.ml

@@ -11,31 +11,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* https://discuss.ocaml.org/t/how-to-create-a-temporary-directory-in-ocaml/1815/4 *)
-let rand_digits () =
-  Printf.sprintf "%06x" Random.State.(bits (make_self_init ()) land 0xFFFFFF)
-
-let mk_temp_dir ?(mode=0o700) ?dir pat =
-  let dir = match dir with
-    | Some d -> d
-    | None   -> Filename.get_temp_dir_name ()
-  in
-  let raise_err msg = raise (Sys_error msg) in
-  let rec loop count =
-    if count < 0
-    then
-      raise_err "mk_temp_dir: too many failing attemps"
-    else
-      let dir = Printf.sprintf "%s/%s%s" dir pat (rand_digits ()) in
-      try (Unix.mkdir dir mode; dir) with
-      | Unix.Unix_error (Unix.EEXIST, _, _) -> loop (count - 1)
-      | Unix.Unix_error (Unix.EINTR, _, _)  -> loop count
-      | Unix.Unix_error (e, _, _)           ->
-          raise_err ("mk_temp_dir: " ^ (Unix.error_message e))
-  in
-  loop 1000
-
 let make_n_enter dirname_pattern =
-  let rundir = mk_temp_dir dirname_pattern in
+  let rundir = Superbol_platform.Tempdir.create dirname_pattern in
   Unix.chdir rundir;
   rundir