Use Fpath to represent file paths (#64)

* Use Fpath to represent file paths

* Update the docs

* Fix problems due to Fpath.parent being not the same Filename.dirname

* Update tests to accept that '//////' gets normalized to '//' by Fpath

core/Cmd.ml

@@ -3,7 +3,7 @@
 *)
 
 open Printf
-open Filename_.Operators
+open Fpath_.Operators
 open Cmdliner
 
 (*

core/Cmd.mli

@@ -19,9 +19,9 @@ type subcommand_result =
 *)
 val interpret_argv :
   ?argv:string array ->
-  ?expectation_workspace_root:Filename_.t ->
+  ?expectation_workspace_root:Fpath.t ->
   ?handle_subcommand_result:(int -> subcommand_result -> unit) ->
-  ?status_workspace_root:Filename_.t ->
+  ?status_workspace_root:Fpath.t ->
   project_name:string ->
   (unit -> Types.test list) ->
   unit Promise.t

core/Filename_.ml

@@ -1,20 +1,12 @@
 (*
-   A trivial wrapper around "string" to make signatures clearer.
+   Subset of the standard 'Filename' module using 'Fpath.t' for the type
+   of file paths.
 *)
 
-type t = string
+let temp_file ?temp_dir prefix suffix =
+  Filename.temp_file
+    ?temp_dir:(Option.map Fpath.to_string temp_dir)
+    prefix suffix
+  |> Fpath.v
 
-let of_string x = x
-let to_string x = x
-
-include Filename
-
-module Operators = struct
-  let ( // ) a b =
-    if is_relative b then concat a b else b
-
-  let ( / ) a seg =
-    concat a seg
-
-  let ( !! ) path = path
-end
+let get_temp_dir_name () = Filename.get_temp_dir_name () |> Fpath.v

core/Filename_.mli

@@ -1,36 +1,7 @@
 (*
-   A trivial wrapper around "string" to make signatures clearer.
-   For internal use only.
-
-   It would be nicer to use 'Fpath' but we're trying to minimize
-   dependencies outside the standard library.
+   Subset of the standard 'Filename' module using 'Fpath.t' for the type
+   of file paths.
 *)
 
-type t
-
-val of_string : string -> t
-val to_string : t -> string
-
-(* Functions from the 'Filename' module. *)
-val basename : t -> string
-val dirname : t -> t
-val is_relative : t -> bool
-val concat : t -> t -> t
-val dir_sep : string
-val temp_file : ?temp_dir:t -> string -> string -> t
-
-(* Extensions *)
-module Operators : sig
-  (* Turn a, b into a/b; turn a, /b into /b.
-     Same as ( // ) in Fpath. *)
-  val ( // ) : t -> t -> t
-
-  (* Append a path segment.
-     Same as ( / ) in Fpath.
-     The appended segment shouldn't contain slashes or backslashes
-     but this isn't enforced. *)
-  val ( / ) : t -> string -> t
-
-  (* to_string *)
-  val ( !! ) : t -> string
-end
+val temp_file : ?temp_dir:Fpath.t -> string -> string -> Fpath.t
+val get_temp_dir_name : unit -> Fpath.t

core/Fpath_.ml

@@ -0,0 +1,15 @@
+(*
+   Extensions of the Fpath module which deals with file paths.
+*)
+
+module Operators = struct
+  let ( // ) = Fpath.( // )
+  let ( / ) = Fpath.( / )
+  let ( !! ) = Fpath.to_string
+end
+
+let to_string_list paths = List.rev_map Fpath.to_string paths |> List.rev
+
+let dirname path =
+  let dir, _basename = Fpath.split_base path in
+  Fpath.rem_empty_seg dir

core/Fpath_.mli

@@ -0,0 +1,26 @@
+(*
+   Extensions of the Fpath module which deals with file paths.
+*)
+
+(* Operators can be put in scope with 'open Fpath_.Operators' *)
+module Operators : sig
+  val ( // ) : Fpath.t -> Fpath.t -> Fpath.t
+  val ( / ) : Fpath.t -> string -> Fpath.t
+
+  (* to_string *)
+  val ( !! ) : Fpath.t -> string
+end
+
+val to_string_list : Fpath.t list -> string list
+
+(* Same as Filename.dirname:
+
+   /a/b -> /a
+   /a/b/ -> /a
+   /a -> /
+   a -> .
+   / -> / (!)
+   . -> . (!)
+   /a/.. -> /a (!)
+*)
+val dirname : Fpath.t -> Fpath.t

core/Helpers.ml

@@ -3,7 +3,7 @@
 *)
 
 open Printf
-open Filename_.Operators
+open Fpath_.Operators
 module P = Promise
 
 (* safe version of List.map for ocaml < 5 *)
@@ -13,37 +13,45 @@ let list_map f l = List.rev_map f l |> List.rev
 let list_flatten ll =
   List.fold_left (fun acc l -> List.rev_append l acc) [] ll |> List.rev
 
-let rec make_dir_if_not_exists ?(recursive = false) (dir : Filename_.t) =
-  match (Unix.stat !!dir).st_kind with
-  | S_DIR -> ()
-  | S_REG
-  | S_CHR
-  | S_BLK
-  | S_LNK
-  | S_FIFO
-  | S_SOCK ->
-      Error.fail
-        (sprintf
-           "File %S already exists but is not a folder as required by the \
-            testing setup."
-           !!dir)
-  | exception Unix.Unix_error (ENOENT, _, _) ->
-      let parent = Filename_.dirname dir in
-      if parent = dir then
-        (* dir is something like "." or "/" *)
+let make_dir_if_not_exists ?(recursive = false) (dir : Fpath.t) =
+  let rec mkdir dir =
+    match (Unix.stat !!dir).st_kind with
+    | S_DIR -> ()
+    | S_REG
+    | S_CHR
+    | S_BLK
+    | S_LNK
+    | S_FIFO
+    | S_SOCK ->
         Error.fail
           (sprintf
-             "Folder %S doesn't exist and has no parent that we could create."
+             "File %S already exists but is not a folder as required by the \
+              testing setup."
              !!dir)
-      else if recursive then (
-        make_dir_if_not_exists ~recursive parent;
-        Unix.mkdir !!dir 0o777)
-      else if Sys.file_exists !!parent then
-        Unix.mkdir !!dir 0o777
-      else
-        Error.fail
-          (sprintf "The parent folder of %S doesn't exist (current folder: %S)"
-             !!dir (Sys.getcwd ()))
+    | exception Unix.Unix_error (ENOENT, _, _) ->
+        let parent = Fpath_.dirname dir in
+        if parent = dir then
+          (* dir is something like "." or "/" *)
+          Error.fail
+            (sprintf
+               "Folder %S doesn't exist and has no parent that we could create."
+               !!dir)
+        else if recursive then (
+          mkdir parent;
+          Unix.mkdir !!dir 0o777
+        )
+        else if Sys.file_exists !!parent then
+          Unix.mkdir !!dir 0o777
+        else
+          Error.fail
+            (sprintf
+               "The parent folder of %S doesn't exist (current folder: %S)"
+               !!dir (Sys.getcwd ()))
+  in
+  dir
+  |> Fpath.normalize
+  |> Fpath.rem_empty_seg
+  |> mkdir
 
 let contains_pcre_pattern pat =
   let rex = Re.Pcre.regexp pat in
@@ -53,7 +61,7 @@ let contains_substring substring =
   contains_pcre_pattern (Re.Pcre.quote substring)
 
 let write_file path data =
-  let oc = open_out_bin (Filename_.to_string path) in
+  let oc = open_out_bin !!path in
   Fun.protect
     (fun () -> output_string oc data)
     ~finally:(fun () -> close_out_noerr oc)

core/Helpers.mli

@@ -11,20 +11,20 @@ val list_flatten : 'a list list -> 'a list
 (* Create a directory if it doesn't exist.
    Also create its parents if they don't exist and 'recursive' is true.
 *)
-val make_dir_if_not_exists : ?recursive:bool -> Filename_.t -> unit
+val make_dir_if_not_exists : ?recursive:bool -> Fpath.t -> unit
 
 val contains_pcre_pattern : string -> (string -> bool)
 
 val contains_substring : string -> (string -> bool)
 
-val write_file : Filename_.t -> string -> unit
-val read_file : Filename_.t -> string
+val write_file : Fpath.t -> string -> unit
+val read_file : Fpath.t -> string
 
 (* Work with a temporary file, ensuring its eventual deletion. *)
 val with_temp_file :
   ?contents:string ->
   ?persist:bool ->
   ?prefix:string ->
   ?suffix:string ->
-  ?temp_dir:Filename_.t ->
-  (Filename_.t -> 'a Promise.t) -> 'a Promise.t
+  ?temp_dir:Fpath.t ->
+  (Fpath.t -> 'a Promise.t) -> 'a Promise.t

core/Run.ml

@@ -3,7 +3,7 @@
 *)
 
 open Printf
-open Filename_.Operators
+open Fpath_.Operators
 open Promise.Operators
 module T = Types
 module P = Promise
@@ -497,20 +497,20 @@ let print_status ~highlight_test ~always_show_unchecked_output
         (match status.expectation.expected_output with
         | Error (Missing_files [ path ]) ->
             print_error
-              (sprintf "Missing file containing the expected output: %s" path)
+              (sprintf "Missing file containing the expected output: %s" !!path)
         | Error (Missing_files paths) ->
             print_error
               (sprintf "Missing files containing the expected output: %s"
-                 (String.concat ", " paths))
+                 (String.concat ", " (Fpath_.to_string_list paths)))
         | Ok _expected_output -> (
             match status.result with
             | Error (Missing_files [ path ]) ->
                 print_error
-                  (sprintf "Missing file containing the test output: %s" path)
+                  (sprintf "Missing file containing the test output: %s" !!path)
             | Error (Missing_files paths) ->
                 print_error
                   (sprintf "Missing files containing the test output: %s"
-                     (String.concat ", " paths))
+                     (String.concat ", " (Fpath_.to_string_list paths)))
             | Ok _ -> ()));
         let capture_paths = Store.capture_paths_of_test test in
         show_output_details test sum capture_paths;

core/Store.ml

@@ -18,7 +18,7 @@
 *)
 
 open Printf
-open Filename_.Operators (* // / !! *)
+open Fpath_.Operators (* // / !! *)
 open Promise.Operators (* >>= *)
 module T = Types
 module P = Promise
@@ -42,9 +42,9 @@ type capture_paths = {
   short_name : string;
   (* None if this is file that holds the leftover logs that are not
      checked against expectations but directed to a file nonetheless. *)
-  path_to_expected_output : Filename_.t option;
+  path_to_expected_output : Fpath.t option;
   (* Path to the file where the captured output is redirected. *)
-  path_to_output : Filename_.t;
+  path_to_output : Fpath.t;
 }
 
 let list_map f xs = List.rev_map f xs |> List.rev
@@ -73,10 +73,10 @@ let with_file_out path f =
   let oc = open_out_bin !!path in
   Fun.protect ~finally:(fun () -> close_out_noerr oc) (fun () -> f oc)
 
-let read_file path : (string, Filename_.t (* missing file *)) Result.t =
+let read_file path : (string, Fpath.t (* missing file *)) Result.t =
   with_file_in path (fun ic -> really_input_string ic (in_channel_length ic))
 
-let errmsg_of_missing_file (path : Filename_.t) : string =
+let errmsg_of_missing_file (path : Fpath.t) : string =
   sprintf "Missing or inaccessible file %s" !!path
 
 let read_file_exn path : string =
@@ -95,13 +95,13 @@ let remove_file path = if Sys.file_exists !!path then Sys.remove !!path
    The status workspace is a temporary folder outside of version control.
 *)
 let default_status_workspace_root =
-  Filename_.of_string "_build" / "testo" / "status"
+  Fpath.v "_build" / "testo" / "status"
 
 (*
    The expectation workspace is under version control.
 *)
 let default_expectation_workspace_root =
-  Filename_.of_string "tests" / "snapshots"
+  Fpath.v "tests" / "snapshots"
 
 let not_initialized () =
   Error.fail "Missing initialization call: Testo.init ()"
@@ -183,7 +183,7 @@ let set_outcome (test : T.test) outcome =
   outcome |> string_of_outcome |> write_file path
 
 let get_outcome (test : T.test) :
-    (T.outcome, Filename_.t (* missing file *)) Result.t =
+    (T.outcome, Fpath.t (* missing file *)) Result.t =
   let path = get_outcome_path test in
   match read_file path with
   | Ok data -> Ok (outcome_of_string path data)
@@ -219,7 +219,7 @@ let short_name_of_checked_output_options
     default_name (options : T.checked_output_options) =
   match options.expected_output_path with
   | None -> default_name
-  | Some path -> Filename_.basename path
+  | Some path -> Fpath.basename path
 
 let get_output_path (test : T.test) filename =
   get_status_workspace () / test.id / filename
@@ -364,7 +364,7 @@ let set_expected_output
   else
     List.iter2
       (fun path data ->
-         Helpers.make_dir_if_not_exists (Filename_.dirname path);
+         Helpers.make_dir_if_not_exists (Fpath.parent path);
          write_file path data)
       paths data
 
@@ -464,7 +464,7 @@ let normalize_output (test : T.test) =
       get_checked_output_paths paths
       |> List.iter (fun std_path ->
              let backup_path =
-               Filename_.of_string (!!std_path ^ orig_suffix) in
+               Fpath.v (!!std_path ^ orig_suffix) in
              if Sys.file_exists !!backup_path then Sys.remove !!backup_path;
              Sys.rename !!std_path !!backup_path;
              let orig_data = read_file_exn backup_path in
@@ -595,15 +595,14 @@ let get_expectation
     |> (function
       | Ok x -> Ok (expected_output_of_data test.checked_output x)
       | Error missing_files ->
-          let missing_files = list_map Filename_.to_string missing_files in
           Error (T.Missing_files missing_files))
   in
   { expected_outcome = test.expected_outcome; expected_output }
 
 let get_result (test : T.test) (paths : capture_paths list)
   : (T.result, T.missing_files) Result.t =
   match get_outcome test with
-  | Error missing_file -> Error (Missing_files [ !!missing_file ])
+  | Error missing_file -> Error (Missing_files [ missing_file ])
   | Ok outcome -> (
       let opt_captured_output =
         paths
@@ -613,7 +612,7 @@ let get_result (test : T.test) (paths : capture_paths list)
       in
       match opt_captured_output with
       | Error missing_files ->
-          Error (Missing_files (list_map (!!) missing_files))
+          Error (Missing_files missing_files)
       | Ok captured_output ->
           Ok { outcome; captured_output }
     )