Ignore backup files

CHANGES.md

@@ -13,6 +13,8 @@
   error messages (#176, @gpetiot)
 - Use the 'user' field in the configuration before inferring it from repo URI
   and handles HTTPS URIs (#183, @gpetiot)
+- Ignore backup files when looking for README, CHANGES and LICENSE files
+  (#194, @gpetiot)
 
 ### Removed
 

lib/archive.ml

@@ -5,7 +5,7 @@
   ---------------------------------------------------------------------------*)
 
 open Bos_setup
-open Stdext
+module Sbytes = Stdext.Sbytes
 
 (* Ustar archives *)
 

lib/pkg.ml

@@ -139,19 +139,14 @@ let delegate p =
 let build_dir p =
   match p.build_dir with Some b -> Ok b | None -> Ok (Fpath.v "_build")
 
-let find_file path name =
-  let open Fpath in
+let find_files path ~name_wo_ext =
   OS.Dir.contents path >>| fun files ->
-  List.filter
-    (fun file ->
-      let name_no_ext = to_string (normalize (rem_ext file)) in
-      String.equal name (String.Ascii.lowercase name_no_ext))
-    files
+  Stdext.Path.find_files files ~name_wo_ext
 
 let readmes p =
   match p.readmes with
   | Some f -> Ok f
-  | None -> find_file (Fpath.v ".") "readme"
+  | None -> find_files (Fpath.v ".") ~name_wo_ext:"readme"
 
 let readme p =
   readmes p >>= function
@@ -198,7 +193,7 @@ let opam_descr p =
 let change_logs p =
   match p.change_logs with
   | Some f -> Ok f
-  | None -> find_file (Fpath.v ".") "changes"
+  | None -> find_files (Fpath.v ".") ~name_wo_ext:"changes"
 
 let change_log p =
   change_logs p >>= function
@@ -208,7 +203,7 @@ let change_log p =
 let licenses p =
   match p.licenses with
   | Some f -> Ok f
-  | None -> find_file (Fpath.v ".") "license"
+  | None -> find_files (Fpath.v ".") ~name_wo_ext:"license"
 
 let dev_repo p =
   opam_field_hd p "dev-repo" >>= function

lib/stdext.ml

@@ -10,3 +10,23 @@ module Sbytes = struct
     try R.ok (Bytes.blit_string src srcoff dst dstoff len)
     with Invalid_argument e -> R.error_msg e
 end
+
+module Path = struct
+  let is_backup_file str =
+    let len = String.length str in
+    len > 0
+    &&
+    let first = str.[0] in
+    let last = str.[len - 1] in
+    Char.equal last '~' || (Char.equal first '#' && Char.equal last '#')
+
+  let find_files ~name_wo_ext files =
+    let open Fpath in
+    List.filter
+      (fun file ->
+        if is_backup_file (filename file) then false
+        else
+          let normalized = to_string (normalize (rem_ext file)) in
+          String.equal name_wo_ext (String.Ascii.lowercase normalized))
+      files
+end

lib/stdext.mli

@@ -17,3 +17,16 @@ module Sbytes : sig
       a valid range of [src], or if [dstoff] and [len] do not designate a valid
       range of [dst]. *)
 end
+
+module Path : sig
+  val is_backup_file : string -> bool
+  (** [is_backup_file s] returns [true] iff the filename [s]:
+
+      - ends with ['~']
+      - or begins with ['#'] and ends with ['#']. *)
+
+  val find_files : name_wo_ext:string -> Fpath.t list -> Fpath.t list
+  (** [find_files ~name_wo_ext files] returns the list of files among [files]
+      whose name without the extension is equal to [name_wo_ext]. Backup files
+      are ignored. *)
+end

tests/alcotest_ext.ml

@@ -0,0 +1,8 @@
+open Alcotest
+
+let path = testable Fpath.pp Fpath.equal
+
+let error_msg =
+  testable Bos_setup.R.pp_msg (fun (`Msg e1) (`Msg e2) -> String.equal e1 e2)
+
+let result_msg testable = result testable error_msg

tests/alcotest_ext.mli

@@ -0,0 +1,6 @@
+open Alcotest
+open Bos_setup
+
+val path : Fpath.t testable
+
+val result_msg : 'a testable -> ('a, R.msg) result testable

tests/test_stdext.ml

@@ -0,0 +1,35 @@
+let is_backup_file () =
+  let check ~input ~expected =
+    let name = "Path.is_backup_file " ^ input in
+    let actual = Dune_release.Stdext.Path.is_backup_file input in
+    Alcotest.(check bool) name expected actual
+  in
+  check ~input:"" ~expected:false;
+  check ~input:"fooooooooooooo" ~expected:false;
+  check ~input:"fooooooooo#" ~expected:false;
+  check ~input:"#fooooooooo#" ~expected:true;
+  check ~input:"foooooooooooo~" ~expected:true
+
+let find_files () =
+  let check ~name ~paths ~name_wo_ext ~expected =
+    let paths = List.map Fpath.v paths in
+    let expected = List.map Fpath.v expected in
+    let actual = Dune_release.Stdext.Path.find_files ~name_wo_ext paths in
+    let open Alcotest in
+    let open Alcotest_ext in
+    (check (list path)) name expected actual
+  in
+  check ~name:"Path.find_files empty" ~paths:[] ~name_wo_ext:"" ~expected:[];
+  check ~name:"Path.find_files does not contain" ~name_wo_ext:"foo"
+    ~paths:[ "aaa"; "bbb"; "#foo#"; "foo~"; ".foo.md.swp" ]
+    ~expected:[];
+  check ~name:"Path.find_files contains" ~name_wo_ext:"foo"
+    ~paths:[ "aaa"; "bbb"; "#foo#"; "foo~"; ".foo.md.swp"; "foo"; "foo.ml" ]
+    ~expected:[ "foo"; "foo.ml" ]
+
+let suite =
+  ( "Stdext",
+    [
+      ("Path.is_backup_file", `Quick, is_backup_file);
+      ("Path.find_files", `Quick, find_files);
+    ] )

tests/tests.ml

@@ -1,3 +1,3 @@
 let () =
   Alcotest.run "dune-release"
-    [ Test_github.suite; Test_pkg.suite; Test_tags.suite ]
+    [ Test_github.suite; Test_pkg.suite; Test_stdext.suite; Test_tags.suite ]