Add support for empty files through git extensions

patch.opam

@@ -3,7 +3,7 @@ version: "3.0.0~alpha1"
 maintainer: "Hannes Mehnert <hannes@mehnert.org>"
 authors: [
   "Hannes Mehnert <hannes@mehnert.org>"
-  "Kate <kit-ty-kate@outlook.com>"
+  "Kate <kit-ty-kate@exn.st>"
 ]
 homepage: "https://github.com/hannesm/patch"
 doc: "https://hannesm.github.io/patch/"

src/fname.ml

@@ -97,27 +97,54 @@ let parse s =
         Ok (Some filename)
   | Error _ as err -> err
 
-let parse_git_header s =
-  let parse s =
-    match parse_filename ~allow_space:true s with
-    | Ok (s, "") -> Ok (Lib.String.cut '/' s)
-    | Ok _ -> Error "Unexpected character after closing double-quote in header"
-    | Error _ as err -> err
-  in
-  let rec loop s len i =
-    if i < len then
-      match s.[i] with
+let parse_git_filename s =
+  match parse_filename ~allow_space:true s with
+  | Ok (s, "") -> Ok s
+  | Ok _ -> Error "Unexpected character after closing double-quote in header"
+  | Error _ as err -> err
+
+let parse_git_header_rename ~from_ ~to_ s =
+  let rec loop ~s ~len i =
+    if i < (len : int) then
+      match String.unsafe_get s i with
       | ' ' | '\t' ->
-          let a = parse (Lib.String.slice ~stop:i s) in
-          let b = parse (Lib.String.slice ~start:(i + 1) s) in
+          let a = parse_git_filename (Lib.String.slice ~stop:i s) in
+          let b = parse_git_filename (Lib.String.slice ~start:(i + 1) s) in
           begin match a, b with
-          | Ok (Some ("a", a)), Ok (Some ("b", b))
-            when a = (b : string) ->
-              Some a
-          | _, _ -> loop s len (i + 1)
+          | Ok a, Ok b
+            when Lib.String.is_suffix ~suffix:from_ a &&
+                 Lib.String.is_suffix ~suffix:to_ b
+            -> Some (a, b)
+          | Ok _, Ok _ | Error _, _ | _, Error _
+            -> loop ~s ~len (i + 1)
           end
-      | _ -> loop s len (i + 1)
+      | _ -> loop ~s ~len (i + 1)
     else
       None
   in
-  loop s (String.length s) 0
+  loop ~s ~len:(String.length s) 0
+
+let parse_git_header_same s =
+  let rec loop ~best ~s ~len i =
+    if i < (len : int) then
+      match String.unsafe_get s i with
+      | ' ' | '\t' ->
+          let a = parse_git_filename (Lib.String.slice ~stop:i s) in
+          let b = parse_git_filename (Lib.String.slice ~start:(i + 1) s) in
+          begin match a, b with
+          | Ok a, Ok b ->
+              begin match best, Lib.String.count_common_suffix a b with
+              | None, best -> loop ~best:(Some (best, a, b)) ~s ~len (i + 1)
+              | Some (prev_best, _, _), best when best > (prev_best : int) ->
+                  loop ~best:(Some (best, a, b)) ~s ~len (i + 1)
+              | Some _ as best, _ -> loop ~best ~s ~len (i + 1)
+              end
+          | Error _, _ | _, Error _ -> loop ~best ~s ~len (i + 1)
+          end
+      | _ -> loop ~best ~s ~len (i + 1)
+    else
+      match best with
+      | None -> None
+      | Some (_best, a, b) -> Some (a, b)
+  in
+  loop ~best:None ~s ~len:(String.length s) 0

src/fname.mli

@@ -4,4 +4,15 @@ val parse : string -> (string option, string) result
 
     Returns [Error msg] in case of error. *)
 
-val parse_git_header : string -> string option
+(** {1 Git header parsers} *)
+
+val parse_git_header_rename :
+  from_:string -> to_:string -> string -> (string * string) option
+(** [parse_git_header_rename ~from_ ~to_ str] will parse [str] by trying to
+    match [from_] and [to_] on the left side and right side of the space split
+    respectively. Returns [None] if nothing was able to be found. *)
+
+val parse_git_header_same : string -> (string * string) option
+(** [parse_git_header_same str] will parse [str] by trying to get the largest
+    equal suffix for both filenames in the git header. Returns [None] if
+    nothing was able to be found. *)

src/lib.ml

@@ -38,6 +38,18 @@ module String = struct
     in
     let len = stop - start in
     String.sub str start len
+
+  let count_common_suffix x y =
+    let rec loop ~x ~y acc ix iy =
+      if ix >= 0 && iy >= 0 &&
+         String.unsafe_get x ix = (String.unsafe_get y iy : char) then
+        loop ~x ~y (acc + 1) (ix - 1) (iy - 1)
+      else
+        acc
+    in
+    let len_x = String.length x in
+    let len_y = String.length y in
+    loop ~x ~y 0 (len_x - 1) (len_y - 1)
 end
 
 module List = struct

src/lib.mli

@@ -4,6 +4,7 @@ module String : sig
   val cut : char -> string -> (string * string) option
   val cuts : char -> string -> string list
   val slice : ?start:int -> ?stop:int -> string -> string
+  val count_common_suffix : string -> string -> int
 end
 
 module List : sig

src/patch.ml

@@ -202,18 +202,36 @@ let rec to_hunks (mine_no_nl, their_no_nl, acc) = function
     | None, mine_no_nl, their_no_nl, rest -> List.rev acc, mine_no_nl, their_no_nl, rest
     | Some hunk, mine_no_nl, their_no_nl, rest -> to_hunks (mine_no_nl, their_no_nl, hunk :: acc) rest
 
+type git_ext =
+  | Rename_only of string * string
+  | Delete_only
+  | Create_only
+
 type operation =
   | Edit of string * string
   | Delete of string
   | Create of string
-  | Rename_only of string * string
+  | Git_ext of (string * string * git_ext)
+
+let git_ext_eq a b = match a, b with
+  | Delete_only, Delete_only
+  | Create_only, Create_only
+    -> true
+  | Rename_only (a, b), Rename_only (a', b')
+    -> String.equal a a' && String.equal b b'
+  | Rename_only _, _ | Delete_only, _ | Create_only, _
+    -> false
 
 let operation_eq a b = match a, b with
   | Delete a, Delete b
-  | Create a, Create b -> String.equal a b
-  | Edit (a, a'), Edit (b, b')
-  | Rename_only (a, a'), Rename_only (b, b') -> String.equal a b && String.equal a' b'
-  | Delete _, _ | Create _, _ | Edit _, _ | Rename_only _, _ -> false
+  | Create a, Create b
+    -> String.equal a b
+  | Edit (a, b), Edit (a', b')
+    -> String.equal a a' && String.equal b b'
+  | Git_ext (a, b, ext1), Git_ext (a', b', ext2)
+    -> String.equal a a' && String.equal b b' && git_ext_eq ext1 ext2
+  | Edit _, _ | Delete _, _ | Create _, _ | Git_ext _, _
+    -> false
 
 let no_file = "/dev/null"
 
@@ -257,8 +275,7 @@ let pp_filename ppf fn =
   else
     Format.pp_print_text ppf fn
 
-let pp_operation ppf op =
-  match op with
+let pp_operation ppf = function
   | Edit (old_name, new_name) ->
     Format.fprintf ppf "--- %a\n" pp_filename old_name ;
     Format.fprintf ppf "+++ %a\n" pp_filename new_name
@@ -268,10 +285,16 @@ let pp_operation ppf op =
   | Create name ->
     Format.fprintf ppf "--- %a\n" pp_filename no_file ;
     Format.fprintf ppf "+++ %a\n" pp_filename name
-  | Rename_only (old_name, new_name) ->
-    Format.fprintf ppf "diff --git %a %a\n" pp_filename old_name pp_filename new_name;
-    Format.fprintf ppf "rename from %a\n" pp_filename old_name;
-    Format.fprintf ppf "rename to %a\n" pp_filename new_name
+  | Git_ext (a, b, ext) ->
+      Format.fprintf ppf "diff --git %a %a\n" pp_filename a pp_filename b;
+      match ext with
+      | Rename_only (from_, to_) ->
+          Format.fprintf ppf "rename from %a\n" pp_filename from_;
+          Format.fprintf ppf "rename to %a\n" pp_filename to_
+      | Delete_only ->
+          Format.pp_print_string ppf "deleted file mode 100644\n";
+      | Create_only ->
+          Format.pp_print_string ppf "new file mode 100644\n";
 
 type t = {
   operation : operation ;
@@ -283,7 +306,12 @@ type t = {
 let pp ppf {operation; hunks; mine_no_nl; their_no_nl} =
   pp_operation ppf operation;
   let rec aux = function
-    | [] -> ()
+    | [] ->
+        begin match operation with
+        | Edit _ | Delete _ | Create _ ->
+            assert false
+        | Git_ext _ -> () (* already delt with in pp_operation *)
+        end
     | [x] -> pp_hunk ~mine_no_nl ~their_no_nl ppf x
     | x::xs ->
         pp_hunk ~mine_no_nl:false ~their_no_nl:false ppf x;
@@ -327,40 +355,83 @@ let operation_of_strings ~p mine their =
 
 let parse_one ~p data =
   let open (struct
-    type mode = Git of string option
+    type mode = Git of string
   end) in
   let is_git = function
     | Some (Git _) -> true
     | None -> false
   in
   (* first locate --- and +++ lines *)
   let rec find_start ~mode ~git_action = function
-    | [] -> git_action, []
+    | [] ->
+        begin match git_action with
+        | Some git_action -> Some (Git_ext git_action), []
+        | None -> None, []
+        end
     | x::xs when Lib.String.is_prefix ~prefix:"diff --git " x ->
-        let git_filename = Fname.parse_git_header (Lib.String.slice ~start:11 x) in
         begin match mode, git_action with
-        | (None | Some (Git _)), None -> find_start ~mode:(Some (Git git_filename)) ~git_action:None xs
+        | (None | Some (Git _)), None -> find_start ~mode:(Some (Git x)) ~git_action:None xs
         | None, Some _ -> assert false (* impossible state *)
-        | Some (Git _), Some git_action -> (Some git_action, x :: xs)
+        | Some (Git _), Some git_action -> (Some (Git_ext git_action), x :: xs)
         end
     | x::y::xs when is_git mode && Lib.String.is_prefix ~prefix:"rename from " x && Lib.String.is_prefix ~prefix:"rename to " y ->
-      let git_action = Some (Rename_only (Lib.String.slice ~start:12 x, Lib.String.slice ~start:10 y)) in
-      find_start ~mode ~git_action xs
+        let git_action = match mode with
+          | None -> assert false
+          | Some (Git git_filenames) ->
+              let from_ = Lib.String.slice ~start:12 x in
+              let to_ = Lib.String.slice ~start:10 y in
+              let git_filenames = Lib.String.slice ~start:11 git_filenames in
+              match Fname.parse_git_header_rename ~from_ ~to_ git_filenames with
+              | None -> git_action
+              | Some (a, b) ->
+                  let a = strip_prefix ~p a in
+                  let b = strip_prefix ~p b in
+                  Some (a, b, Rename_only (from_, to_))
+        in
+        find_start ~mode ~git_action xs
     | x::xs when is_git mode && Lib.String.is_prefix ~prefix:"deleted file mode " x ->
         let git_action = match mode with
-          | Some (Git (Some git_filename)) -> Some (Delete git_filename)
-          | Some (Git None) -> git_action
           | None -> assert false
+          | Some (Git git_filenames) ->
+              let git_filenames = Lib.String.slice ~start:11 git_filenames in
+              match Fname.parse_git_header_same git_filenames with
+              | None -> git_action
+              | Some (a, b) ->
+                  let a = strip_prefix ~p a in
+                  let b = strip_prefix ~p b in
+                  Some (a, b, Delete_only)
+        in
+        find_start ~mode ~git_action xs
+    | x::xs when is_git mode && Lib.String.is_prefix ~prefix:"new file mode " x ->
+        let git_action = match mode with
+          | None -> assert false
+          | Some (Git git_filenames) ->
+              let git_filenames = Lib.String.slice ~start:11 git_filenames in
+              match Fname.parse_git_header_same git_filenames with
+              | None -> git_action
+              | Some (a, b) ->
+                  let a = strip_prefix ~p a in
+                  let b = strip_prefix ~p b in
+                  Some (a, b, Create_only)
         in
         find_start ~mode ~git_action xs
     | x::y::xs when Lib.String.is_prefix ~prefix:"--- " x && Lib.String.is_prefix ~prefix:"+++ " y ->
-      Some (operation_of_strings ~p x y), xs
+        begin match git_action, operation_of_strings ~p x y with
+        | None, op -> Some op, xs
+        | Some (f, _, Delete_only), (Delete f' as op)
+        | Some (_, f, Create_only), (Create f' as op)
+          when String.equal f f' -> Some op, xs
+        | Some (a, b, Rename_only (_, _)), (Edit (a', b') as op)
+          when String.equal a a' && String.equal b b' -> Some op, xs
+        | Some (_, _, (Rename_only _ | Delete_only | Create_only) as git_op), _
+          -> Some (Git_ext git_op), x :: y :: xs
+        end
     | x::y::_xs when Lib.String.is_prefix ~prefix:"*** " x && Lib.String.is_prefix ~prefix:"--- " y ->
       failwith "Context diffs are not supported"
     | _::xs -> find_start ~mode ~git_action xs
   in
   match find_start ~mode:None ~git_action:None data with
-  | Some (Rename_only _ as operation), rest ->
+  | Some (Git_ext _ as operation), rest ->
     let hunks = [] and mine_no_nl = false and their_no_nl = false in
     Some ({ operation ; hunks ; mine_no_nl ; their_no_nl }, rest)
   | Some operation, rest ->
@@ -383,7 +454,14 @@ let parse ~p data =
 
 let patch ~cleanly filedata diff =
   match diff.operation with
-  | Rename_only _ -> filedata
+  | Git_ext (_, _, ext) ->
+      if diff.hunks <> [] then
+        assert false;
+      begin match ext with
+      | Rename_only _ -> filedata
+      | Delete_only -> None
+      | Create_only -> Some ""
+      end
   | Delete _ -> None
   | Create _ ->
     begin match diff.hunks with
@@ -461,9 +539,15 @@ let diff_op operation a b =
     ~their_start:(if b = "" then 0 else 1) ~their_len:0 ~their:[]
     (to_lines a) (to_lines b)
 
-let diff operation a b = match a, b with
+let diff a b = match a, b with
   | None, None -> invalid_arg "no input given"
-  | None, Some b -> diff_op operation "" b
-  | Some a, None -> diff_op operation a ""
-  | Some a, Some b when String.equal a b -> None (* NOTE: Optimization *)
-  | Some a, Some b -> diff_op operation a b
+  | None, Some (filename_b, "") ->
+      Some { operation = Git_ext (filename_b, filename_b, Create_only);
+             hunks = []; mine_no_nl = true; their_no_nl = true; }
+  | Some (filename_a, ""), None ->
+      Some { operation = Git_ext (filename_a, filename_a, Delete_only);
+             hunks = []; mine_no_nl = true; their_no_nl = true; }
+  | None, Some (filename_b, b) -> diff_op (Create filename_b) "" b
+  | Some (filename_a, a), None -> diff_op (Delete filename_a) a ""
+  | Some (_, a), Some (_, b) when String.equal a b -> None (* NOTE: Optimization *)
+  | Some (filename_a, a), Some (filename_b, b) -> diff_op (Edit (filename_a, filename_b)) a b

src/patch.mli

@@ -22,14 +22,34 @@ val pp_hunk : mine_no_nl:bool -> their_no_nl:bool -> Format.formatter -> hunk ->
 (** [pp_hunk ppf hunk] pretty-prints the [hunk] on [ppf], the printing is in the
     same format as [diff] does. *)
 
+type git_ext =
+  | Rename_only of string * string
+  | Delete_only
+  | Create_only
+
 type operation =
   | Edit of string * string
   | Delete of string
   | Create of string
-  | Rename_only of string * string
-  (** The operation of a diff: in-place [Edit], [Delete], [Create], [Rename_only].
+  | Git_ext of (string * string * git_ext)
+  (** The operation of a diff: in-place [Edit], [Delete], [Create].
+      And its git-extensions: [Rename_only], [Delete_only], [Create_only].
       The parameters to the variants are filenames.
-      NOTE: in a typical git diff file, [Rename_only] does not have any prefix. *)
+
+      Note that [Edit] also renames the given file under certain conditions
+      and the file to use is driven by this POSIX rule:
+      https://pubs.opengroup.org/onlinepubs/9799919799/utilities/patch.html#tag_20_92_13_02
+
+      Note also that the two filenames in [Git_ext] represent what would be
+      in [git --diff <filename1> <filename2>] with their respective prefixes
+      removed if parsed with [parse ~p:1] or above.
+
+      Warning: The two parameters of [Rename_only] represent the values of the
+      [rename from <filename1>] and [rename to <filename2>] following the
+      specs of the git extensions. Following the behaviour of GNU Patch which
+      ignores these two lines, it is recommended to get the filenames from
+      [Git_ext] instead of from [Rename_only], which are used only for
+      pretty-printing. *)
 
 val pp_operation : Format.formatter -> operation -> unit
 (** [pp_operation ppf op] pretty-prints the operation [op] on [ppf]. *)
@@ -65,8 +85,8 @@ val patch : cleanly:bool -> string option -> t -> string option
 (** [patch file_contents diff] applies [diff] on [file_contents], resulting in
     the new file contents (or None if deleted). *)
 
-val diff : operation -> string option -> string option -> t option
-(** [diff operation content_a content_b] creates a diff between
+val diff : (string * string) option -> (string * string) option -> t option
+(** [diff (filename_a, content_a) (filename_b, content_b)] creates a diff between
     [content_a] and [content_b]. Returns [None] if no changes could be detected.
 
-    @raise Invalid_argument if both [content_a] and [content_b] are [None]. *)
+    @raise Invalid_argument if both arguments are [None]. *)

test/data/create-empty-only.diff

@@ -0,0 +1,3 @@
+diff --git b/create-empty-only b/create-empty-only
+new file mode 100644
+index 0000000..e69de29