(** Tree and commit diff operations. *) type change = | Added of { path : string; hash : Hash.t; perm : Tree.perm } | Removed of { path : string; hash : Hash.t; perm : Tree.perm } | Modified of { path : string; old_hash : Hash.t; new_hash : Hash.t; old_perm : Tree.perm; new_perm : Tree.perm; } type t = change list type stats = { additions : int; deletions : int; modifications : int } let change_path = function | Added { path; _ } | Removed { path; _ } | Modified { path; _ } -> path let compare_by_path c1 c2 = String.compare (change_path c1) (change_path c2) let path prefix name = if prefix = "" then name else prefix ^ "/" ^ name (** Read a tree from the repository, returning empty list if not found. *) let read_tree repo hash = match Repository.read repo hash with | Ok (Value.Tree tree) -> Ok (Tree.to_list tree) | Ok _ -> Error (`Msg "expected tree object") | Error e -> Error e (** Check if an entry is a directory (tree). *) let is_dir (entry : Tree.entry) = entry.perm = `Dir (** Recursively collect all entries in a tree as Added changes. *) let rec collect_added repo prefix entries acc = List.fold_left (fun acc (entry : Tree.entry) -> match acc with | Error _ -> acc | Ok changes -> let path = path prefix entry.name in if is_dir entry then (* Recurse into subdirectory *) match read_tree repo entry.hash with | Error e -> Error e | Ok sub_entries -> collect_added repo path sub_entries (Ok changes) else Ok (Added { path; hash = entry.hash; perm = entry.perm } :: changes)) acc entries (** Recursively collect all entries in a tree as Removed changes. *) let rec collect_removed repo prefix entries acc = List.fold_left (fun acc (entry : Tree.entry) -> match acc with | Error _ -> acc | Ok changes -> let path = path prefix entry.name in if is_dir entry then match read_tree repo entry.hash with | Error e -> Error e | Ok sub_entries -> collect_removed repo path sub_entries (Ok changes) else Ok (Removed { path; hash = entry.hash; perm = entry.perm } :: changes)) acc entries (** Process a single added entry (file or directory). *) let process_added_entry repo prefix (entry : Tree.entry) changes = let path = path prefix entry.name in if is_dir entry then match read_tree repo entry.hash with | Error e -> Error e | Ok sub -> collect_added repo path sub (Ok changes) else Ok (Added { path; hash = entry.hash; perm = entry.perm } :: changes) (** Process a single removed entry (file or directory). *) let process_removed_entry repo prefix (entry : Tree.entry) changes = let path = path prefix entry.name in if is_dir entry then match read_tree repo entry.hash with | Error e -> Error e | Ok sub -> collect_removed repo path sub (Ok changes) else Ok (Removed { path; hash = entry.hash; perm = entry.perm } :: changes) (** Handle entries with same name but different content/type. *) let rec process_matched_entries repo prefix old_e new_e changes walk_fn = let path = path prefix old_e.Tree.name in match (is_dir old_e, is_dir new_e) with | true, true -> ( (* Both directories, recurse *) match (read_tree repo old_e.hash, read_tree repo new_e.hash) with | Ok old_entries', Ok new_entries' -> walk_fn repo path old_entries' new_entries' (Ok changes) | Error e, _ | _, Error e -> Error e) | false, false -> (* Both files, content changed *) Ok (Modified { path; old_hash = old_e.hash; new_hash = new_e.hash; old_perm = old_e.perm; new_perm = new_e.perm; } :: changes) | true, false -> ( (* Dir became file: remove dir contents, add file *) match read_tree repo old_e.hash with | Error e -> Error e | Ok sub -> ( match collect_removed repo path sub (Ok changes) with | Error e -> Error e | Ok changes' -> Ok (Added { path; hash = new_e.hash; perm = new_e.perm } :: changes'))) | false, true -> ( (* File became dir: remove file, add dir contents *) let change = Removed { path; hash = old_e.hash; perm = old_e.perm } in match read_tree repo new_e.hash with | Error e -> Error e | Ok sub -> collect_added repo path sub (Ok (change :: changes))) (** Merge-walk two sorted entry lists and compute differences. *) and walk_trees repo prefix old_entries new_entries acc = match (old_entries, new_entries, acc) with | _, _, Error _ -> acc | [], [], Ok changes -> Ok changes | [], new_e :: rest, Ok changes -> ( match process_added_entry repo prefix new_e changes with | Error e -> Error e | Ok changes' -> walk_trees repo prefix [] rest (Ok changes')) | old_e :: rest, [], Ok changes -> ( match process_removed_entry repo prefix old_e changes with | Error e -> Error e | Ok changes' -> walk_trees repo prefix rest [] (Ok changes')) | old_e :: old_rest, new_e :: new_rest, Ok changes -> ( let cmp = String.compare old_e.Tree.name new_e.Tree.name in if cmp < 0 then match process_removed_entry repo prefix old_e changes with | Error e -> Error e | Ok changes' -> walk_trees repo prefix old_rest new_entries (Ok changes') else if cmp > 0 then match process_added_entry repo prefix new_e changes with | Error e -> Error e | Ok changes' -> walk_trees repo prefix old_entries new_rest (Ok changes') else if Hash.equal old_e.hash new_e.hash && old_e.perm = new_e.perm then walk_trees repo prefix old_rest new_rest acc else match process_matched_entries repo prefix old_e new_e changes walk_trees with | Error e -> Error e | Ok changes' -> walk_trees repo prefix old_rest new_rest (Ok changes')) let trees repo ~old_tree ~new_tree = let old_entries = read_tree repo old_tree in let new_entries = read_tree repo new_tree in match (old_entries, new_entries) with | Error e, _ | _, Error e -> Error e | Ok old_e, Ok new_e -> ( match walk_trees repo "" old_e new_e (Ok []) with | Error e -> Error e | Ok changes -> Ok (List.sort compare_by_path changes)) let commits repo ~old_commit ~new_commit = let read_commit_tree hash = match Repository.read repo hash with | Ok (Value.Commit commit) -> Ok (Commit.tree commit) | Ok _ -> Error (`Msg "expected commit object") | Error e -> Error e in match (read_commit_tree old_commit, read_commit_tree new_commit) with | Error e, _ | _, Error e -> Error e | Ok old_tree, Ok new_tree -> trees repo ~old_tree ~new_tree let tree_to_empty repo tree = match read_tree repo tree with | Error e -> Error e | Ok entries -> ( match collect_added repo "" entries (Ok []) with | Error e -> Error e | Ok changes -> Ok (List.sort compare_by_path changes)) let empty_to_tree repo tree = match read_tree repo tree with | Error e -> Error e | Ok entries -> ( match collect_removed repo "" entries (Ok []) with | Error e -> Error e | Ok changes -> Ok (List.sort compare_by_path changes)) let filter_by_path ~prefix diff = let prefix_len = String.length prefix in List.filter (fun change -> let path = change_path change in String.length path >= prefix_len && String.sub path 0 prefix_len = prefix && (String.length path = prefix_len || path.[prefix_len] = '/')) diff let stats diff = List.fold_left (fun acc change -> match change with | Added _ -> { acc with additions = acc.additions + 1 } | Removed _ -> { acc with deletions = acc.deletions + 1 } | Modified _ -> { acc with modifications = acc.modifications + 1 }) { additions = 0; deletions = 0; modifications = 0 } diff let pp_change ppf change = match change with | Added { path; _ } -> Fmt.pf ppf "A %s" path | Removed { path; _ } -> Fmt.pf ppf "D %s" path | Modified { path; _ } -> Fmt.pf ppf "M %s" path let pp ppf diff = Fmt.pf ppf "@[%a@]" Fmt.(list ~sep:cut pp_change) diff let pp_stats ppf stats = Fmt.pf ppf "%d additions, %d deletions, %d modifications" stats.additions stats.deletions stats.modifications