Safer file handling

sherlodoc/store/storage_marshal.ml

@@ -6,6 +6,4 @@ let save ~db t = Marshal.to_channel db t []
 
 let load name =
   let file = open_in name in
-  let t = Marshal.from_channel file in
-  close_in file ;
-  [ t ]
+  Fun.protect ~finally:(fun () -> close_in file) (fun () -> [ Marshal.from_channel file ])

src/driver/library_names.ml

@@ -1,3 +1,5 @@
+open Bos
+
 (** To extract the library names for a given package, without using dune, we
 
     1. parse the META file of the package with ocamlfind to see which libraries
@@ -44,9 +46,11 @@ let read_libraries_from_pkg_defs ~library_name pkg_defs =
 
 let process_meta_file file =
   let () = Format.eprintf "process_meta_file: %s\n%!" (Fpath.to_string file) in
-  let ic = open_in (Fpath.to_string file) in
   let meta_dir = Fpath.parent file in
-  let meta = Fl_metascanner.parse ic in
+  let meta =
+    OS.File.with_ic file (fun ic () -> Fl_metascanner.parse ic) ()
+    |> Result.get_ok
+  in
   let base_library_name =
     if Fpath.basename file = "META" then Fpath.parent file |> Fpath.basename
     else Fpath.get_ext file
@@ -116,7 +120,7 @@ let directories v =
           (* NB. topkg installs a META file that points to a ../topkg-care directory
               that is installed by the topkg-care package. We filter that out here,
               though I've not thought of a good way to sort out the `topkg-care` package *)
-          match Bos.OS.Dir.exists dir with
+          match OS.Dir.exists dir with
           | Ok true -> Fpath.Set.add dir acc
           | _ -> acc))
     Fpath.Set.empty libraries

src/odoc/bin/dune

@@ -3,8 +3,6 @@
  (package odoc)
  (public_name odoc)
  (libraries compatcmdliner odoc_model odoc_odoc)
- (flags
-  (:standard -open StdLabels))
  (instrumentation
   (backend landmarks --auto))
  (instrumentation

src/odoc/bin/main.ml

@@ -3,6 +3,8 @@
    It would make the interaction with jenga nicer if we could specify a file to
    output the result to. *)
 
+open Odoc_utils
+module List = ListLabels
 open Odoc_odoc
 open Compatcmdliner
 
@@ -40,7 +42,7 @@ let convert_fpath =
 
 let convert_named_root =
   let parse inp =
-    match Astring.String.cuts inp ~sep:":" with
+    match String.cuts inp ~sep:":" with
     | [ s1; s2 ] -> Result.Ok (s1, Fs.Directory.of_string s2)
     | _ -> Error (`Msg "")
   in
@@ -190,7 +192,7 @@ module Compile : sig
 end = struct
   let has_page_prefix file =
     file |> Fs.File.basename |> Fs.File.to_string
-    |> Astring.String.is_prefix ~affix:"page-"
+    |> String.is_prefix ~affix:"page-"
 
   let unique_id =
     let doc = "For debugging use" in
@@ -411,7 +413,7 @@ module Compile_impl = struct
   let output_file output_dir parent_id input =
     let name =
       Fs.File.basename input |> Fpath.set_ext "odoc" |> Fs.File.to_string
-      |> Astring.String.Ascii.uncapitalize
+      |> String.Ascii.uncapitalize
     in
     let name = prefix ^ name in
 
@@ -1150,7 +1152,7 @@ module Odoc_html_args = struct
       || str.[0] = '/'
 
     let conv_rel_dir rel =
-      let l = Astring.String.cuts ~sep:"/" rel in
+      let l = String.cuts ~sep:"/" rel in
       List.fold_left
         ~f:(fun acc seg ->
           Some Odoc_document.Url.Path.{ kind = `Page; parent = acc; name = seg })
@@ -1164,7 +1166,7 @@ module Odoc_html_args = struct
           let last_char = str.[String.length str - 1] in
           let str =
             if last_char <> '/' then str
-            else String.sub str ~pos:0 ~len:(String.length str - 1)
+            else String.with_range ~len:(String.length str - 1) str
           in
           `Ok
             (if is_absolute str then (Absolute str : uri)
@@ -1186,7 +1188,7 @@ module Odoc_html_args = struct
         if String.length str = 0 then `Error "invalid URI"
         else
           let conv_rel_file rel =
-            match Astring.String.cut ~rev:true ~sep:"/" rel with
+            match String.cut ~rev:true ~sep:"/" rel with
             | Some (before, after) ->
                 let base = conv_rel_dir before in
                 Odoc_document.Url.Path.
@@ -1268,7 +1270,7 @@ module Odoc_html_args = struct
   let remap =
     let convert_remap =
       let parse inp =
-        match Astring.String.cut ~sep:":" inp with
+        match String.cut ~sep:":" inp with
         | Some (orig, mapped) -> Result.Ok (orig, mapped)
         | _ -> Error (`Msg "Map must be of the form '<orig>:https://...'")
       and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in
@@ -1289,18 +1291,12 @@ module Odoc_html_args = struct
         match remap_file with
         | None -> remap
         | Some f ->
-            let ic = open_in f in
-            let rec loop acc =
-              match input_line ic with
-              | exception _ ->
-                  close_in ic;
-                  acc
-              | line -> (
-                  match Astring.String.cut ~sep:":" line with
-                  | Some (orig, mapped) -> loop ((orig, mapped) :: acc)
-                  | None -> loop acc)
-            in
-            loop []
+            Io_utils.fold_lines f
+              (fun line acc ->
+                match String.cut ~sep:":" line with
+                | Some (orig, mapped) -> (orig, mapped) :: acc
+                | None -> acc)
+              []
       in
       let html_config =
         Odoc_html.Config.v ~theme_uri ~support_uri ~search_uris ~semantic_uris

src/odoc/classify.cppo.ml

@@ -3,8 +3,8 @@
 (* Given a directory with cmis, cmas and so on, partition the modules between the libraries *)
 (* open Bos *)
 
+open Odoc_utils
 open Cmo_format
-open Result
 
 module StringSet = Set.Make (String)
 let list_of_stringset x =
@@ -222,12 +222,12 @@ let classify files libraries =
           (fun cur path ->
             if not (Sys.file_exists path) then cur
             else
-              let ic = open_in_bin path in
+              Io_utils.with_open_in_bin path (fun ic ->
               match read_library ic cur with
               | Ok lib -> lib
               | Error (`Msg m) ->
                   Format.eprintf "Error reading library: %s\n%!" m;
-                  cur)
+                  cur))
           (Archive.empty (Fpath.basename lpath)) paths)
       libraries
   in
@@ -411,7 +411,7 @@ let classify files libraries =
       let archive = Archive.filter_by_cmis cmi_names archive_all in
       if Archive.has_modules archive then
         Printf.printf "%s %s\n" a.Archive.name
-          (archive.Archive.modules |> StringSet.elements |> String.concat " "))
+          (archive.Archive.modules |> StringSet.elements |> String.concat ~sep:" "))
     archives;
 
   ()

src/odoc/fs.ml

@@ -14,6 +14,7 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Odoc_utils
 open StdLabels
 open Or_error
 
@@ -62,16 +63,6 @@ module File = struct
     | Result.Ok p -> p
 
   let read file =
-    let with_ic ~close ic f =
-      let close ic = try close ic with Sys_error _ -> () in
-      match f ic with
-      | v ->
-          close ic;
-          v
-      | exception e ->
-          close ic;
-          raise e
-    in
     let input_one_shot len ic =
       let buf = Bytes.create len in
       really_input ic buf 0 len;
@@ -95,10 +86,10 @@ module File = struct
     in
     try
       let file = Fpath.to_string file in
-      let is_dash = file = "-" in
-      let ic = if is_dash then stdin else open_in_bin file in
-      let close ic = if is_dash then () else close_in ic in
-      with_ic ~close ic @@ fun ic ->
+      let with_ic k =
+        if file = "-" then k stdin else Io_utils.with_open_in_bin file k
+      in
+      with_ic @@ fun ic ->
       match in_channel_length ic with
       | 0 (* e.g. stdin or /dev/stdin *) -> input_stream file ic
       | len when len <= Sys.max_string_length -> input_one_shot len ic
@@ -108,16 +99,10 @@ module File = struct
     with Sys_error e -> Result.Error (`Msg e)
 
   let copy ~src ~dst =
-    let with_ open_ close filename f =
-      let c = open_ (Fpath.to_string filename) in
-      Odoc_utils.Fun.protect ~finally:(fun () -> close c) (fun () -> f c)
-    in
-    let with_ic = with_ open_in_bin close_in_noerr in
-    let with_oc = with_ open_out_bin close_out_noerr in
     try
-      with_ic src (fun ic ->
+      Io_utils.with_open_in_bin (Fpath.to_string src) (fun ic ->
           mkdir_p (dirname dst);
-          with_oc dst (fun oc ->
+          Io_utils.with_open_out_bin (Fpath.to_string dst) (fun oc ->
               let len = 65536 in
               let buf = Bytes.create len in
               let rec loop () =

src/odoc/html_fragment.ml

@@ -1,3 +1,4 @@
+open Odoc_utils
 open Or_error
 
 let from_mld ~xref_base_uri ~resolver ~output ~warnings_options input =
@@ -47,11 +48,8 @@ let from_mld ~xref_base_uri ~resolver ~output ~warnings_options input =
       Odoc_html.Generator.items ~config ~resolve:(Base xref_base_uri)
         (page.Odoc_document.Types.Page.preamble @ page.items)
     in
-    let oc = open_out (Fs.File.to_string output) in
-    let fmt = Format.formatter_of_out_channel oc in
-
+    Io_utils.with_formatter_out (Fs.File.to_string output) @@ fun fmt ->
     Format.fprintf fmt "%a@." (Format.pp_print_list (Tyxml.Html.pp_elt ())) html;
-    close_out oc;
     Ok ()
   in
   match Fs.File.read input with

src/odoc/indexing.ml

@@ -24,11 +24,8 @@ let parse_input_files input =
   >>= fun files -> Ok (List.concat files)
 
 let compile_to_json ~output ~occurrences ~wrap ~simplified hierarchies =
-  let output_channel =
-    Fs.Directory.mkdir_p (Fs.File.dirname output);
-    open_out_bin (Fs.File.to_string output)
-  in
-  let output = Format.formatter_of_out_channel output_channel in
+  Fs.Directory.mkdir_p (Fs.File.dirname output);
+  Io_utils.with_formatter_out (Fs.File.to_string output) @@ fun output ->
   if wrap then Format.fprintf output "let documents = ";
   let all =
     List.fold_left
@@ -47,11 +44,6 @@ let compile_to_json ~output ~occurrences ~wrap ~simplified hierarchies =
        var idx_fuse = new Fuse(documents, options);\n";
   Ok ()
 
-let read_occurrences file =
-  let ic = open_in_bin file in
-  let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
-  htbl
-
 let absolute_normalization p =
   let p =
     if Fpath.is_rel p then Fpath.( // ) (Fpath.v (Sys.getcwd ())) p else p
@@ -70,7 +62,7 @@ let compile out_format ~output ~warnings_options ~occurrences ~roots
   let occurrences =
     match occurrences with
     | None -> None
-    | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))
+    | Some occurrences -> Some (Occurrences.read_occurrences occurrences)
   in
   let all_files =
     roots

src/odoc/occurrences.ml

@@ -1,5 +1,5 @@
+open Odoc_utils
 open Or_error
-open Astring
 
 let handle_file file ~f =
   if String.is_prefix ~affix:"impl-" (Fpath.filename file) then
@@ -31,8 +31,7 @@ let count ~dst ~warnings_options:_ directories include_hidden =
   in
   fold_dirs ~dirs:directories ~f ~init:() >>= fun () ->
   Fs.Directory.mkdir_p (Fs.File.dirname dst);
-  let oc = open_out_bin (Fs.File.to_string dst) in
-  Marshal.to_channel oc htbl [];
+  Io_utils.marshal (Fs.File.to_string dst) htbl;
   Ok ()
 
 open Astring
@@ -54,26 +53,24 @@ let parse_input_files input =
     (Ok []) input
   >>= fun files -> Ok (List.concat files)
 
+let read_occurrences file : Odoc_occurrences.Table.t =
+  Io_utils.unmarshal (Fpath.to_string file)
+
 let aggregate files file_list ~warnings_options:_ ~dst =
   try
     parse_input_files file_list >>= fun new_files ->
     let files = files @ new_files in
-    let from_file file : Odoc_occurrences.Table.t =
-      let ic = open_in_bin (Fs.File.to_string file) in
-      Marshal.from_channel ic
-    in
     let occtbl =
       match files with
       | [] -> Odoc_occurrences.Table.v ()
       | file :: files ->
-          let acc = from_file file in
+          let acc = read_occurrences file in
           List.iter
             (fun file ->
-              Odoc_occurrences.aggregate ~tbl:acc ~data:(from_file file))
+              Odoc_occurrences.aggregate ~tbl:acc ~data:(read_occurrences file))
             files;
           acc
     in
-    let oc = open_out_bin (Fs.File.to_string dst) in
-    Marshal.to_channel oc occtbl [];
+    Io_utils.marshal (Fs.File.to_string dst) occtbl;
     Ok ()
   with Sys_error s -> Error (`Msg s)